===================================================================
RCS file: /cvs/cvsweb/cvsweb.cgi,v
retrieving revision 1.1.1.7
retrieving revision 1.1.1.28
diff -u -p -r1.1.1.7 -r1.1.1.28
--- cvsweb/cvsweb.cgi 2000/09/23 20:23:34 1.1.1.7
+++ cvsweb/cvsweb.cgi 2001/08/01 10:24:01 1.1.1.28
@@ -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,30 +42,36 @@
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.
#
-# $zId: cvsweb.cgi,v 1.103 2000/09/20 17:02:29 jumager Exp $
-# $kId: cvsweb.cgi,v 1.26 2000/09/22 11:13:17 knu Exp $
+# $zId: cvsweb.cgi,v 1.112 2001/07/24 13:03:16 hzeller Exp $
+# $Idaemons: /home/cvs/cvsweb/cvsweb.cgi,v 1.82 2001/08/01 09:54:52 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
@revisions %state %difflines %log %branchpoint @revorder
- $prcgi @prcategories $prcategories $mancgi
+ $prcgi @prcategories $re_prcategories $prkeyword $re_prkeyword $mancgi
$checkoutMagic $doCheckout $scriptname $scriptwhere
$where $pathinfo $Browser $nofilelinks $maycompress @stickyvars
%funcline_regexp $is_mod_perl
- $is_lynx $is_w3m $is_msie $is_mozilla3 $is_textbased
+ $is_links $is_lynx $is_w3m $is_msie $is_mozilla3 $is_textbased
%input $query $barequery $sortby $bydate $byrev $byauthor
- $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
+ $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
$long_intro $short_instruction $shortLogLen
$show_author $dirtable $tablepadding $columnHeaderColorDefault
$columnHeaderColorSorted $hr_breakable $showfunc $hr_ignwhite
@@ -74,15 +80,21 @@ 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
- $checkout_magic $show_subdir_lastmod $show_log_in_markup $v
+ $show_subdir_lastmod $show_log_in_markup $preformat_in_markup $v
$navigationHeaderColor $tableBorderColor $markupLogColor
- $tabstop $state $annTable $sel $curbranch @HideModules
+ $tabstop $state $annTable $sel $curbranch @HideModules @ForbiddenFiles
$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
+ $tmpdir
);
sub printDiffSelect($);
+sub printDiffLinks($$);
+sub printLogSortSelect($);
sub findLastModifiedSubdirs(@);
+sub htmlify_sub(&$);
sub htmlify($;$);
sub spacedHtmlText($;$);
sub link($$);
@@ -90,6 +102,7 @@ sub revcmp($$);
sub fatal($$);
sub redirect($);
sub safeglob($);
+sub search_path($);
sub getMimeTypeFromSuffix($);
sub head($;$);
sub scan_directives(@);
@@ -115,24 +128,36 @@ sub download_url($$;$);
sub download_link($$$;$);
sub toggleQuery($$);
sub urlencode($);
+sub htmlquote($);
+sub htmlunquote($);
+sub hrefquote($);
sub http_header(;$);
sub html_header($);
sub html_footer();
sub link_tags($);
+sub forbidden_file($);
sub forbidden_module($);
##### Start of Configuration Area ########
-use Cwd;
+delete $ENV{PATH};
-# == EDIT this ==
-# User configuration is stored in
-$config = undef;
+$cvsweb_revision =
+ '1.112' . '.' . (
+ split (/ /,
+ q$Idaemons: /home/cvs/cvsweb/cvsweb.cgi,v 1.82 2001/08/01 09:54:52 knu Exp $
+))[2];
-for ($ENV{CVSWEB_CONFIG},
-# '/home/knu/etc/cvsweb.conf',
- '/usr/local/etc/cvsweb.conf',
- getcwd . '/cvsweb.conf') {
- $config = $_ if defined($_) && -r $_;
+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') {
+ if (defined($_) && -r $_) {
+ $config = $_;
+ last;
+ }
}
# == Configuration defaults ==
@@ -144,22 +169,67 @@ $allow_version_select = 1;
######## Configuration variables #########
# These are defined to allow checking with perl -cw
-%CVSROOT = %MIRRORS = %DEFAULTVALUE = %ICONS = %MTYPES =
-%tags = %alltags = @tabcolors = ();
-$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 =
-$hr_ignkeysubst = $diffcolorHeading = $diffcolorEmpty = $diffcolorRemove =
-$diffcolorChange = $diffcolorAdd = $diffcolorDarkChange = $difffontface =
-$difffontsize = $inputTextSize = $mime_types = $allow_annotate =
-$allow_markup = $use_java_script = $open_extern_window =
-$extern_window_width = $extern_window_height = $edit_option_form =
-$checkout_magic = $show_subdir_lastmod = $show_log_in_markup = $v =
-$navigationHeaderColor = $tableBorderColor = $markupLogColor =
-$tabstop = $use_moddate = $moddate = $gzip_open = undef;
+@CVSrepositories = @CVSROOT = %CVSROOT = %MIRRORS = %DEFAULTVALUE = %ICONS =
+ %MTYPES = %tags = %alltags = @tabcolors = %fileinfo = ();
+$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 =
+ $hr_ignkeysubst = $diffcolorHeading = $diffcolorEmpty = $diffcolorRemove =
+ $diffcolorChange = $diffcolorAdd = $diffcolorDarkChange = $difffontface =
+ $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 = $v = $navigationHeaderColor =
+ $tableBorderColor = $markupLogColor = $tabstop = $use_moddate = $moddate =
+ $gzip_open = undef;
+$tmpdir = defined($ENV{TMPDIR}) ? $ENV{TMPDIR} : "/var/tmp";
+$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;
@@ -167,38 +237,43 @@ use IPC::Open2;
# Check if the zlib C library interface is installed, and if yes
# we can avoid using the extra gzip process.
-eval {
- require Compress::Zlib;
-};
+eval { require Compress::Zlib; };
$has_zlib = !$@;
-$verbose = $v;
+$verbose = $v;
$checkoutMagic = "~checkout~";
-$pathinfo = defined($ENV{PATH_INFO}) ? $ENV{PATH_INFO} : '';
-$where = $pathinfo;
-$doCheckout = ($where =~ /^\/$checkoutMagic/);
-$where =~ s|^/($checkoutMagic)?||;
-$where =~ s|/+$||;
+$pathinfo = defined($ENV{PATH_INFO}) ? $ENV{PATH_INFO} : '';
+$where = $pathinfo;
+$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
# per file, so disable the link at the icon
# in this case:
-$Browser = $ENV{HTTP_USER_AGENT};
-$is_lynx = ($Browser =~ m`^Lynx/`i);
-$is_w3m = ($Browser =~ m`^w3m/`i);
-$is_msie = ($Browser =~ m`MSIE`);
+$Browser = $ENV{HTTP_USER_AGENT} || '';
+$is_links = ($Browser =~ m`^Links `);
+$is_lynx = ($Browser =~ m`^Lynx/`i);
+$is_w3m = ($Browser =~ m`^w3m/`i);
+$is_msie = ($Browser =~ m`MSIE`);
$is_mozilla3 = ($Browser =~ m`^Mozilla/[3-9]`);
-$is_textbased = ($is_lynx || $is_w3m);
+$is_textbased = ($is_links || $is_lynx || $is_w3m);
$nofilelinks = $is_textbased;
@@ -211,11 +286,10 @@ $nofilelinks = $is_textbased;
# display garbage then :-/
# Turn off gzip if running under mod_perl and no zlib is available,
# piping does not work as expected inside the server.
-$maycompress = (((defined($ENV{HTTP_ACCEPT_ENCODING})
- && $ENV{HTTP_ACCEPT_ENCODING} =~ m`gzip`)
- || $is_mozilla3)
- && !$is_msie
- && !($is_mod_perl && !$has_zlib));
+$maycompress =
+ (((defined($ENV{HTTP_ACCEPT_ENCODING})
+ && $ENV{HTTP_ACCEPT_ENCODING} =~ m`gzip`) || $is_mozilla3) && !$is_msie
+ && !($is_mod_perl && !$has_zlib));
# put here the variables we need in order
# to hold our state - they will be added (with
@@ -224,29 +298,34 @@ $maycompress = (((defined($ENV{HTTP_ACCEPT_ENCODING})
@stickyvars = qw(cvsroot hideattic sortby logsort f only_with_tag);
if (-f $config) {
- do $config;
+ require $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.'
+ );
}
-else {
- &fatal("500 Internal Error",
- 'Configuration not found. Set the variable $config
'
- . 'in cvsweb.cgi, or the environment variable '
- . 'CVSWEB_CONFIG
, to your cvsweb.conf '
- . 'configuration file first.');
-}
undef %input;
$query = $ENV{QUERY_STRING};
if (defined($query) && $query ne '') {
- foreach (split(/&/, $query)) {
- s/%(..)/sprintf("%c", hex($1))/ge; # unquote %-quoted
- if (/(\S+)=(.*)/) {
- $input{$1} = $2 if ($2 ne "");
+ foreach (split (/&/, $query)) {
+ y/+/ /;
+ s/%(..)/sprintf("%c", hex($1))/ge; # unquote %-quoted
+ if (/(\S+)=(.*)/) {
+ $input{$1} = $2 if ($2 ne "");
+ } else {
+ $input{$_}++;
+ }
}
- else {
- $input{$_}++;
- }
- }
}
# For backwards compability, set only_with_tag to only_on_branch if set.
@@ -255,147 +334,182 @@ $input{only_with_tag} = $input{only_on_branch}
$DEFAULTVALUE{'cvsroot'} = $cvstreedefault;
-foreach (keys %DEFAULTVALUE)
-{
- # replace not given parameters with the default parameters
- if (!defined($input{$_}) || $input{$_} eq "") {
- # Empty Checkboxes in forms return -- nothing. So we define a helper
- # variable in these forms (copt) which indicates that we just set
- # parameters with a checkbox
- if (!defined($input{"copt"})) {
- # 'copt' isn't defined --> empty input is not the result
- # of empty input checkbox --> set default
- $input{$_} = $DEFAULTVALUE{$_} if (defined($DEFAULTVALUE{$_}));
+foreach (keys %DEFAULTVALUE) {
+
+ # replace not given parameters with the default parameters
+ if (!defined($input{$_}) || $input{$_} eq "") {
+
+ # Empty Checkboxes in forms return -- nothing. So we define a helper
+ # variable in these forms (copt) which indicates that we just set
+ # parameters with a checkbox
+ if (!defined($input{"copt"})) {
+
+ # 'copt' isn't defined --> empty input is not the result
+ # of empty input checkbox --> set default
+ $input{$_} = $DEFAULTVALUE{$_}
+ if (defined($DEFAULTVALUE{$_}));
+ } else {
+
+ # 'copt' is defined -> the result of empty input checkbox
+ # -> set to zero (disable) if default is a boolean (0|1).
+ $input{$_} = 0
+ if (defined($DEFAULTVALUE{$_})
+ && ($DEFAULTVALUE{$_} eq "0"
+ || $DEFAULTVALUE{$_} eq "1"));
+ }
}
- else {
- # 'copt' is defined -> the result of empty input checkbox
- # -> set to zero (disable) if default is a boolean (0|1).
- $input{$_} = 0
- if (defined($DEFAULTVALUE{$_})
- && ($DEFAULTVALUE{$_} eq "0" || $DEFAULTVALUE{$_} eq "1"));
- }
- }
}
$barequery = "";
+my @barequery;
foreach (@stickyvars) {
- # construct a query string with the sticky non default parameters set
- if (defined($input{$_}) && $input{$_} ne '' &&
- !(defined($DEFAULTVALUE{$_}) && $input{$_} eq $DEFAULTVALUE{$_})) {
- if ($barequery) {
- $barequery = $barequery . "&";
+
+ # construct a query string with the sticky non default parameters set
+ if (defined($input{$_}) && $input{$_} ne ''
+ && !(defined($DEFAULTVALUE{$_}) && $input{$_} eq $DEFAULTVALUE{$_}))
+ {
+ push @barequery,
+ join ('=', urlencode($_), urlencode($input{$_}));
}
- my $thisval = urlencode($_) . "=" . urlencode($input{$_});
- $barequery .= $thisval;
- }
}
+
# is there any query ?
-if ($barequery) {
- $query = "?$barequery";
- $barequery = "&" . $barequery;
+if (@barequery) {
+ $barequery = join ('&', @barequery);
+ $query = "?$barequery";
+ $barequery = "&$barequery";
+} else {
+ $query = "";
}
-else {
- $query = "";
+undef @barequery;
+
+if (defined($input{path})) {
+ redirect("$scriptname/$input{path}$query");
}
# get actual parameters
-$sortby = $input{"sortby"};
-$bydate = 0;
-$byrev = 0;
+$sortby = $input{"sortby"};
+$bydate = 0;
+$byrev = 0;
$byauthor = 0;
-$bylog = 0;
-$byfile = 0;
+$bylog = 0;
+$byfile = 0;
if ($sortby eq "date") {
- $bydate = 1;
+ $bydate = 1;
+} elsif ($sortby eq "rev") {
+ $byrev = 1;
+} elsif ($sortby eq "author") {
+ $byauthor = 1;
+} elsif ($sortby eq "log") {
+ $bylog = 1;
+} else {
+ $byfile = 1;
}
-elsif ($sortby eq "rev") {
- $byrev = 1;
-}
-elsif ($sortby eq "author") {
- $byauthor = 1;
-}
-elsif ($sortby eq "log") {
- $bylog = 1;
-}
-else {
- $byfile = 1;
-}
-$hr_default = $input{'f'} eq 'h';
+$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",
- "\$cvstreedefault
points to a repository "
- . "not defined in %CVSROOT
"
- . "(edit your configuration file $config)");
+ &fatal("500 Internal Error",
+ "\$cvstreedefault
points to a repository ($cvstreedefault) "
+ . "not defined in %CVSROOT
"
+ . "(edit your configuration file $config)");
}
# alternate CVS-Tree, configured in cvsweb.conf
if ($input{'cvsroot'} && $CVSROOT{$input{'cvsroot'}}) {
- $cvstree = $input{'cvsroot'};
+ $cvstree = $input{'cvsroot'};
} else {
- $cvstree = $cvstreedefault;
+ $cvstree = $cvstreedefault;
}
$cvsroot = $CVSROOT{$cvstree};
# create icons out of description
-foreach my $k (keys %ICONS) {
- no strict 'refs';
- my ($itxt,$ipath,$iwidth,$iheight) = @{$ICONS{$k}};
- if ($ipath) {
- ${"${k}icon"} = "";
- }
- else {
- ${"${k}icon"} = $itxt;
- }
+my $k;
+foreach $k (keys %ICONS) {
+ no strict 'refs';
+ my ($itxt, $ipath, $iwidth, $iheight) = @{$ICONS{$k}};
+ if ($ipath) {
+ ${"${k}icon"} =
+ sprintf(
+ '',
+ hrefquote($ipath), htmlquote($itxt), $iwidth, $iheight)
+ } else {
+ ${"${k}icon"} = $itxt;
+ }
}
+undef $k;
+my $config_cvstree = "$config-$cvstree";
+
# Do some special configuration for cvstrees
-do "$config-$cvstree" if (-f "$config-$cvstree");
+if (-f $config_cvstree) {
+ require $config_cvstree || &fatal(
+ "500 Internal Error",
+ sprintf(
+ 'Error in loading configuration file: %s
%s
',
+ $config_cvstree,
+ &htmlify($@)
+ )
+ );
+}
+undef $config_cvstree;
-$prcategories = '(?:' . join('|', @prcategories) . ')';
+$re_prcategories = '(?:' . join ('|', @prcategories) . ')' if @prcategories;
+$re_prkeyword = quotemeta($prkeyword) if defined($prkeyword);
$prcgi .= '%s' if defined($prcgi) && $prcgi !~ /%s/;
-$fullname = $cvsroot . '/' . $where;
-$mimetype = &getMimeTypeFromSuffix ($fullname);
+$fullname = "$cvsroot/$where";
+$mimetype = &getMimeTypeFromSuffix($fullname);
$defaultTextPlain = ($mimetype eq "text/plain");
-$defaultViewable = $allow_markup && viewable($mimetype);
+$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.'); + &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.'
+ );
}
#
@@ -404,145 +518,259 @@ if (!-d $cvsroot) {
$where =~ m:([^/]*):;
$module = $1;
if ($module && &forbidden_module($module)) {
- &fatal("403 Forbidden", "Access to $where forbidden.");
+ &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
###############################
-elsif (-d $fullname) {
- my $dh = do {local(*DH);};
- opendir($dh, $fullname) || &fatal("404 Not Found","$where: $!");
+if (-d $fullname) {
+ my $dh = do { local (*DH); };
+ opendir($dh, $fullname) || &fatal("404 Not Found", "$where: $!");
my @dir = readdir($dh);
closedir($dh);
my @subLevelFiles = findLastModifiedSubdirs(@dir)
if ($show_subdir_lastmod);
- getDirLogs($cvsroot,$where,@subLevelFiles);
+ getDirLogs($cvsroot, $where, @subLevelFiles);
if ($where eq '/') {
- html_header($defaulttitle);
- $long_intro =~ s/!!CVSROOTdescr!!/$CVSROOTdescr{$cvstree}/g;
- print $long_intro;
+ html_header($defaulttitle);
+ $long_intro =~ s/!!CVSROOTdescr!!/$CVSROOTdescr{$cvstree}/g;
+ print $long_intro;
+ } else {
+ html_header($where);
+ print $short_instruction;
}
- else {
- html_header($where);
- print $short_instruction;
- }
my $descriptions;
- if (($use_descriptions) && open (DESC, "<$cvsroot/CVSROOT/descriptions")) {
- while ( \n";
+
# give direct access to dirs
if ($where eq '/') {
- chooseMirror();
- chooseCVSRoot();
- }
- else {
- print " Current directory: ", &clickablePath($where,0), "\n";
+ chooseMirror ();
+ chooseCVSRoot ();
+ } else {
+ print " Current directory: ", &clickablePath($where, 0),
+ "\n";
- print " Current tag: ", $input{only_with_tag}, "\n" if
- $input{only_with_tag};
+ print " Current tag: ", $input{only_with_tag}, "\n"
+ if $input{only_with_tag};
}
-
print " NOTE: There are $filesexists files, but none matches the current tag ($input{only_with_tag})\n";
+ print
+ " NOTE: There are $filesexists files, but none matches the current tag ($input{only_with_tag})\n";
}
- if ($input{only_with_tag} && (!%tags || !$tags{$input{only_with_tag}})) {
- %tags = %alltags
+ if ($input{only_with_tag} && (!%tags || !$tags{$input{only_with_tag}}))
+ {
+ %tags = %alltags
}
- if (scalar %tags
- || $input{only_with_tag}
- || $edit_option_form
- || defined($input{"options"})) {
- print "
\n";
+
# Using \n");
if ($filesexists && !$filesfound) {
- print "
";
+
+ if (scalar %tags || $input{only_with_tag} || $edit_option_form
+ || defined($input{"options"}))
+ {
+ print "
";
}
if (scalar %tags || $input{only_with_tag}) {
- print "\n";
+ && $input{$var} ne "" && $var ne "only_with_tag");
+ }
+ print "Show only files with 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",
+ "