===================================================================
RCS file: /cvs/cvsweb/cvsweb.cgi,v
retrieving revision 1.1.1.33
retrieving revision 4.39
diff -u -p -r1.1.1.33 -r4.39
--- cvsweb/cvsweb.cgi 2002/07/23 16:15:22 1.1.1.33
+++ cvsweb/cvsweb.cgi 2019/11/29 23:42:40 4.39
@@ -1,4 +1,6 @@
-#!/usr/bin/perl -wT
+#!/usr/bin/perl
+# $Id: cvsweb.cgi,v 4.39 2019/11/29 23:42:40 schwarze Exp $
+# $knu: cvsweb.cgi,v 1.299 2010/11/13 16:37:18 simon
#
# cvsweb - a CGI interface to CVS trees.
#
@@ -21,7 +23,7 @@
# (c) 1998-1999 Henner Zeller
# (c) 1999 Henrik Nordstrom
# (c) 2000-2002 Akinori MUSHA
-# (c) 2002 Ville Skyttä
+# (c) 2002-2005 Ville Skyttä
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
@@ -44,62 +46,93 @@
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.
-#
-# $FreeBSD: projects/cvsweb/cvsweb.cgi,v 1.119 2002/07/23 13:58:32 scop Exp $
-# $zId: cvsweb.cgi,v 1.112 2001/07/24 13:03:16 hzeller Exp $
-# $Idaemons: /home/cvs/cvsweb/cvsweb.cgi,v 1.84 2001/10/07 20:50:10 knu Exp $
-#
-###
-require 5.000;
+require 5.006;
use strict;
+use warnings;
+use filetest qw(access);
use vars qw (
- $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 $re_prcategories $prkeyword $re_prkeyword $mancgi
- $checkoutMagic $doCheckout $scriptname $scriptwhere
- $where $pathinfo $Browser $nofilelinks $maycompress
- @stickyvars @unsafevars
- %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 $output_filter $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
- $hr_ignkeysubst $diffcolorHeading $diffcolorEmpty $diffcolorRemove
- $diffcolorChange $diffcolorAdd $diffcolorDarkChange $difffontface
- $difffontsize $inputTextSize $mime_types
- $allow_annotate $allow_markup
- $allow_log_extra $allow_dir_extra $allow_source_extra
- $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
- $navigationHeaderColor $tableBorderColor $markupLogColor
- $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 $HTML_DOCTYPE $HTML_META
+ $VERSION $CheckoutMagic $MimeTypes $DEBUG
+ @CVSrepositories @CVSROOT %CVSROOT %CVSROOTdescr %DEFAULTVALUE %MTYPES
+ @DIFFTYPES %DIFFTYPES @LOGSORTKEYS %LOGSORTKEYS
+ %alltags %fileinfo %tags @branchnames %nameprinted
+ %symrev %revsym @allrevisions %date %author @revdisplayorder
+ @revisions %state %difflines %log %branchpoint @revorder $keywordsubstitution
+ $mancgi $doCheckout $scriptname $scriptwhere
+ $where $Browser $nofilelinks $maycompress @stickyvars
+ $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
+ %CMD $allow_compress $backicon $diricon $fileicon
+ $fullname $logo $defaulttitle $address $binfileicon $iconsdir
+ $shortLogLen $show_author $hr_breakable $hr_ignwhite $hr_ignkeysubst
+ $mime_types $allow_annotate $allow_markup $allow_mailtos
+ $allow_log_extra $allow_dir_extra $allow_source_extra
+ $edit_option_form
+ $show_subdir_lastmod $show_log_in_markup $preformat_in_markup
+ $tabstop $state $annTable $sel @ForbiddenFiles
+ $use_descriptions %descriptions $dwhere
+ $use_moddate $gzip_open $file_list_len
+ $allow_tar @tar_options @cvs_options
+ @annotate_options @rcsdiff_options
+ $HTML_DOCTYPE $HTML_META $cssurl $CSS
);
-sub printDiffSelect($);
-sub printDiffLinks($$);
-sub printLogSortSelect($);
+require Compress::Zlib;
+use Cwd qw(abs_path);
+use File::Path qw(rmtree);
+use File::Spec::Functions qw(canonpath catdir catfile curdir devnull rootdir
+ tmpdir updir);
+use File::Temp qw(tempdir);
+use IPC::Run qw();
+use Time::Local qw(timegm);
+use URI::Escape qw(uri_escape uri_unescape);
+
+use constant VALID_PATH => qr/^([[:^cntrl:]]+)$/o;
+use constant VALID_TAG1 => qr/^([a-zA-Z][[:graph:]]*)$/o;
+use constant VALID_TAG2 => qr/^([^\$,.:;@]+)$/o;
+use constant CVSWEBMARKUP => qr{^text/(x-cvsweb|vnd\.viewcvs)-markup$}io;
+use constant LOG_FILESEPR => qr/^={77}$/o;
+use constant LOG_REVSEPR => qr/^-{28}$/o;
+
+# -----------------------------------------------------------------------------
+
+# All global initialization that can be done in compile time should go to
+# the BEGIN block. Persistent environments, such as mod_perl, will benefit
+# from this.
+
+BEGIN
+{
+ $VERSION = '3.1';
+
+ $HTML_DOCTYPE =
+ '';
+
+ $HTML_META = <%s
":
%s', + $config, $@; + fatal '500 Internal Error', + 'Cannot read configuration file "
%s
": %s',
+ $config, $! || 'unknown error';
+}
-$LOG_FILESEPARATOR = q/^={77}$/;
-$LOG_REVSEPARATOR = q/^-{28}$/;
+######## other global variables #########
-@DIFFTYPES = qw(h H u c s);
+@DIFFTYPES = qw(h H u c);
@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,
- },
+ {
+ '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,
+ },
);
@LOGSORTKEYS = qw(cvs date rev);
@LOGSORTKEYS{@LOGSORTKEYS} = (
- {
- 'descr' => 'Not sorted',
- },
- {
- 'descr' => 'Commit date',
- },
- {
- 'descr' => 'Revision',
- },
+ { descr => 'Not sorted', },
+ { descr => 'Commit date', },
+ { descr => 'Revision', },
);
-$HTML_DOCTYPE =
- '';
+%alltags = ();
+@CVSROOT = ();
+%CVSROOT = ();
+%CVSROOTdescr = ();
+%fileinfo = ();
+$gzip_open = 0;
+%tags = ();
-$HTML_META = <%s
',
+ $ENV{PATH_INFO});
+}
+if ($ENV{SCRIPT_NAME}) {
+ ($scriptname) = ($ENV{SCRIPT_NAME} =~ VALID_PATH)
+ or fatal('500 Internal Error',
+ 'Illegal SCRIPT_NAME in environment: %s
',
+ $ENV{SCRIPT_NAME});
+}
-use Time::Local ();
-use IPC::Open2 qw(open2);
+$scriptname = '' unless defined($scriptname);
-# Check if the zlib C library interface is installed, and if yes
-# we can avoid using the extra gzip process.
-eval { require Compress::Zlib; };
-$has_zlib = !$@;
+$where = $pathinfo;
+$doCheckout = $where =~ s|^/$CheckoutMagic/|/|o;
+$where =~ s|^/||;
+$scriptname =~ s|^/+||;
-$verbose = $v;
-$checkoutMagic = "~checkout~";
-$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|^/*|/|;
-
# Let's workaround thttpd's stupidity..
if ($scriptname =~ m|/$|) {
- $pathinfo .= '/';
- my $re = quotemeta $pathinfo;
- $scriptname =~ s/$re$//;
+ $pathinfo .= '/';
+ my $re = quotemeta $pathinfo;
+ $scriptname =~ s/$re$//;
}
+$scriptname = "/$scriptname" if $scriptname;
-$scriptwhere = $scriptname;
-$scriptwhere .= '/' . urlencode($where);
-$where = '/' if ($where eq '');
+# $scriptname : the URI escaped path to this script
+# $where : the path in the CVS repository (without leading /, or only /)
+# $scriptwhere: the URI escaped $scriptname + '/' + $where
+$scriptname = uri_escape_path($scriptname);
+$scriptwhere = join('/', $scriptname, uri_escape_path($where));
+$where = '/' if ($where eq '');
-$is_mod_perl = defined($ENV{MOD_PERL});
+# In text-based browsers, it's very annoying to have two links per file;
+# skip linking the image for them.
-# 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_links = ($Browser =~ m`^Links `);
+$Browser = $ENV{HTTP_USER_AGENT} || '';
+$is_links = ($Browser =~ m`^E?Links `);
$is_lynx = ($Browser =~ m`^Lynx/`i);
$is_w3m = ($Browser =~ m`^w3m/`i);
$is_msie = ($Browser =~ m`MSIE`);
@@ -301,811 +371,859 @@ $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} =~ /gzip/)
+ || $is_mozilla3)
+ && !$is_msie
+ && !(defined($ENV{MOD_PERL}))
+);
-# put here the variables we need in order
-# to hold our state - they will be added (with
-# their current value) to any link/query string
-# you construct
-@stickyvars = qw(cvsroot hideattic sortby logsort f only_with_tag);
-@unsafevars = qw(logsort only_with_tag r1 r2 rev sortby tr1 tr2);
+# Parameters that will be sticky in all constructed links/query strings.
+@stickyvars =
+ qw(cvsroot hideattic ignorecase sortby logsort f only_with_tag ln
+ hidecvsroot hidenonreadable);
-if (-f $config) {
- do "$config" or fatal("500 Internal Error",
- 'Error in loading configuration file: %s$config
in cvsweb.cgi to your cvsweb.conf configuration file first.'
- );
+# Try to find a readable dir where we can cd into. Some abs_path()
+# implementations as well as various cvs operations require such a dir to
+# work properly.
+{
+ local $^W = 0;
+ for my $dir (tmpdir(), rootdir()) {
+ last if (-r $dir && chdir($dir));
+ }
}
-undef %input;
-$query = $ENV{QUERY_STRING};
+$CSS = $cssurl ?
+ sprintf("\n",
+ htmlquote($cssurl)) : '';
-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 "");
- } else {
- $input{$_}++;
- }
- }
+# --- input parameters
+
+my %query = ();
+if (defined($ENV{QUERY_STRING})) {
+ for my $p (split(/[;&]+/, $ENV{QUERY_STRING})) {
+ next unless $p;
+ $p =~ y/+/ /;
+ my ($key, $val) = split(/=/, $p, 2);
+ next unless defined($key);
+ $key = uri_unescape($key);
+ $key =~ /([^a-z_12-])/ and fatal('404 Not Found',
+ 'Invalid character "%s" in query parameter "%s"', $1, $key);
+ if (defined $val) {
+ $val = uri_unescape($val);
+ $val =~ /([^a-zA-Z_01-9.\/-])/ and fatal('404 Not Found',
+ 'Invalid character "%s" in the value "%s" of the query parameter "%s"',
+ $1, $val, $key);
+ } else {
+ $val = 1;
+ }
+ $query{$key} = $val;
+ }
}
-# For backwards compability, set only_with_tag to only_on_branch if set.
-$input{only_with_tag} = $input{only_on_branch}
- if (defined($input{only_on_branch}));
+undef %input;
-# Prevent cross-site scripting
-foreach (@unsafevars) {
- # Colons are needed in diffs between tags.
- if (defined($input{$_}) && $input{$_} =~ /[^\w\-.:]/) {
- fatal("500 Internal Error",
- 'Malformed query (%s=%s)',
- $_, $input{$_});
- }
+my $t;
+for my $p (qw(hideattic hidecvsroot hidenonreadable ignorecase ln copt
+ options tarball)) {
+ $t = $query{$p};
+ if (defined($t)) {
+ ($input{$p}) = ($t =~ /^([01]|on)$/)
+ or fatal('500 Internal Error',
+ 'Invalid boolean value: %s=%s
', $p, $t);
+ }
}
+for my $p (qw(annotate r1 r2 rev tr1 tr2)) {
+ $t = $query{$p};
+ if (defined($t)) {
+ if (($p eq 'r1' || $p eq 'r2') && $t eq 'text') {
+ # Special case for the "Use text field" option in the log view diff form.
+ $input{$p} = $t;
+ next;
+ } elsif (($p eq 'rev' || $p eq 'annotate') && ($t eq '.' || $t eq 'HEAD')){
+ # Another special case, allow linking to latest revision using these.
+ $input{$p} = '.';
+ next;
+ }
+ my ($rev, $tag) = split(/:/, $t, 2);
+ ($input{$p}) = ($rev =~ /^(\d+(?:\.\d+)*)$/)
+ or fatal('500 Internal Error',
+ 'Invalid revision: %s=%s
', $p, $t);
+ if (defined($tag)) {
+ ($tag) = ($tag =~ VALID_TAG1)
+ or fatal('500 Internal Error',
+ 'Invalid tag/branch name in revision: %s=%s
',
+ $p, $t);
+ ($tag) = ($tag =~ VALID_TAG2)
+ or fatal('500 Internal Error',
+ 'Invalid tag/branch name in revision: %s=%s
',
+ $p, $t);
+ $input{$p} .= ':' . $tag;
+ }
+ }
+}
+$t = defined($query{only_with_tag}) ?
+ $query{only_with_tag} : $query{only_on_branch}; # Backwards compatibility.
+if (defined($t)) {
+ ($input{only_with_tag}) = ($t =~ VALID_TAG1)
+ or fatal('500 Internal Error',
+ 'Invalid tag/branch name: %s
', $t);
+ ($input{only_with_tag}) = ($t =~ VALID_TAG2)
+ or fatal('500 Internal Error',
+ 'Invalid tag/branch name: %s
', $t);
+}
+$t = $query{logsort};
+if (defined($t)) {
+ ($input{logsort}) = ($t =~ /^(cvs|date|rev)$/)
+ or fatal('500 Internal Error',
+ 'Unsupported log sort key: %s
', $t);
+}
+$t = $query{f};
+if (defined($t)) {
+ ($input{f}) = ($t =~ /^(([hH]|[ucs]c?)|ext\d*)$/)
+ or fatal('500 Internal Error',
+ 'Unsupported diff format: %s
', $t);
+}
+$t = $query{sortby};
+if (defined($t)) {
+ ($input{sortby}) = ($t =~ /^(file|date|rev|author|log)$/)
+ or fatal('500 Internal Error',
+ 'Unsupported dir sort key: %s
', $t);
+}
+$t = $query{'content-type'};
+if (defined($t)) {
+ ($input{'content-type'}) = ($t =~ m|^([-0-9A-Za-z]+/[-0-9A-Za-z\.\+]+)$|)
+ or fatal('500 Internal Error',
+ 'Unsupported content type: %s
', $t);
+}
+$t = $query{cvsroot};
+if (defined($t)) {
+ ($input{cvsroot}) = ($t =~ /^([[:print:]]+)$/)
+ or fatal('500 Internal Error',
+ 'Invalid symbolic CVS root name: %s
', $t);
+}
+$t = $query{path};
+if (defined($t)) {
+ ($input{path}) = ($t =~ VALID_PATH)
+ or fatal('500 Internal Error',
+ 'Invalid path: %s
', $t);
+}
+undef($t);
+undef(%query);
-if (defined($input{"content-type"})) {
- fatal("500 Internal Error", "Unsupported content-type")
- if ($input{"content-type"} !~ /^[-0-9A-Za-z]+\/[-0-9A-Za-z]+$/);
+# --- end input parameters
+
+#
+# CVS roots
+#
+my $rootfound = 0;
+for (my $i = 0; $i < scalar(@CVSrepositories); $i += 2) {
+ my $key = $CVSrepositories[$i];
+ my ($descr, $root) = @{$CVSrepositories[$i+1]};
+ $root = canonpath($root);
+ unless (-d $root) {
+ warn("Root '$root' defined in \@CVSrepositories is not a directory, " .
+ 'entry ignored');
+ next;
+ }
+ $rootfound ||= 1;
+ $CVSROOTdescr{$key} = $descr;
+ $CVSROOT{$key} = $root;
+ push(@CVSROOT, $key);
}
+unless ($rootfound) {
+ fatal('500 Internal Error', 'no valid CVS roots found');
+}
+undef $rootfound;
-$DEFAULTVALUE{'cvsroot'} = $cvstreedefault;
+$DEFAULTVALUE{cvsroot} = $CVSrepositories[0];
-foreach (keys %DEFAULTVALUE) {
+while (my ($key, $defval) = each %DEFAULTVALUE) {
- # replace not given parameters with the default parameters
- if (!defined($input{$_}) || $input{$_} eq "") {
+ # Replace not given parameters with defaults.
+ next unless (defined($defval) && $defval =~ /\S/ && !defined($input{$key}));
- # 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"})) {
+ # Empty checkboxes in forms return nothing, so we define a helper parameter
+ # in these forms (copt) which indicates that we just set parameters with a
+ # checkbox.
+ if ($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 set -> the result of empty input checkbox
+ # -> set to zero (disable) if default is a boolean (0|1).
+ $input{$key} = 0 if ($defval eq '0' || $defval eq '1');
- # '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' isn't set --> empty input is not the result
+ # of empty input checkbox --> set default.
+ $input{$key} = $defval;
+ }
}
$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{$_}))
- {
- push @barequery,
- join ('=', urlencode($_), urlencode($input{$_}));
- }
+ # construct a query string with the sticky non default parameters set
+ if (defined($input{$_})
+ && !(defined($DEFAULTVALUE{$_}) && $input{$_} eq $DEFAULTVALUE{$_}))
+ {
+ push(@barequery, join('=', uri_escape($_), uri_escape($input{$_})));
+ }
}
# is there any query ?
if (@barequery) {
- $barequery = join ('&', @barequery);
- $query = "?$barequery";
- $barequery = "&$barequery";
+ $barequery = join (';', @barequery);
+ $query = "?$barequery";
+ $barequery = ";$barequery";
} else {
- $query = "";
+ $query = "";
}
undef @barequery;
if (defined($input{path})) {
- redirect("$scriptname/$input{path}$query");
+ redirect("$scriptname/$input{path}$query");
}
# get actual parameters
-$sortby = $input{"sortby"};
-$bydate = 0;
-$byrev = 0;
-$byauthor = 0;
-$bylog = 0;
-$byfile = 0;
-if ($sortby eq "date") {
- $bydate = 1;
-} elsif ($sortby eq "rev") {
- $byrev = 1;
-} elsif ($sortby eq "author") {
- $byauthor = 1;
-} elsif ($sortby eq "log") {
- $bylog = 1;
-} else {
- $byfile = 1;
-}
-
-$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;
- }
+ my $sortby = $input{sortby} || 'file';
+ $bydate = 0;
+ $byrev = 0;
+ $byauthor = 0;
+ $bylog = 0;
+ $byfile = 0;
+ if ($sortby eq 'date') {
+ $bydate = 1;
+ } elsif ($sortby eq 'rev') {
+ $byrev = 1;
+ } elsif ($sortby eq 'author') {
+ $byauthor = 1;
+ } elsif ($sortby eq 'log') {
+ $bylog = 1;
+ } else {
+ $byfile = 1;
+ }
}
-## Default CVS-Tree
-if (!defined($CVSROOT{$cvstreedefault})) {
- fatal("500 Internal Error",
- '$cvstreedefault
points to a repository (%s) not defined in %%CVSROOT
(edit your configuration file %s)',
- $cvstreedefault, $config);
-}
+$defaultDiffType = $input{f};
+$logsort = $input{logsort};
+
# alternate CVS-Tree, configured in cvsweb.conf
-if ($input{'cvsroot'} && $CVSROOT{$input{'cvsroot'}}) {
- $cvstree = $input{'cvsroot'};
+if ($input{cvsroot} && $CVSROOT{$input{cvsroot}}) {
+ $cvstree = $input{cvsroot};
} else {
- $cvstree = $cvstreedefault;
+ $cvstree = $CVSrepositories[0];
}
$cvsroot = $CVSROOT{$cvstree};
-# create icons out of description
-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;
- }
+if ($iconsdir) {
+ $backicon = '';
+ $diricon = '';
+ $fileicon = '';
+ $binfileicon = '';
+} else {
+ $backicon = 'back';
+ $diricon = 'dir';
+ $fileicon = 'file';
+ $binfileicon = 'binfile';
}
-undef $k;
-my $config_cvstree = "$config-$cvstree";
+$fullname = catfile($cvsroot, $where);
-# Do some special configuration for cvstrees
-if (-f $config_cvstree) {
- do "$config_cvstree" or
- fatal("500 Internal Error",
- 'Error in loading configuration file: %sThe 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.'); } # -# See if the module is in our forbidden list. +# Short-circuit forbidden things. Note that $fullname should not change +# after this, because the rest of the code assumes this check has already +# been done. # -$where =~ m:([^/]*):; -$module = $1; -if ($module && &forbidden_module($module)) { - fatal("403 Forbidden", - 'Access to %s forbidden.', - $where); -} +fatal('403 Forbidden', 'Access to %s forbidden.', $where) + if forbidden($fullname); # # 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,([^/]+)$,); + fatal('403 Forbidden', 'Downloading tarballs is prohibited.') + unless $allow_tar; - if ($basedir eq '' || $module eq '') { - fatal("500 Internal Error", - 'You cannot download the top level directory.'); - } + my ($module) = ($where =~ m,^/?(.*),); # untaint + $module =~ s,/([^/]*)$,,; + my ($ext) = ($1 =~ /(\.t(?:ar\.)?gz)$/); + my ($basedir) = ($module =~ m,([^/]+)$,); - my $tmpexportdir = "$tmpdir/.cvsweb.$$." . int(time); + if ($basedir eq '' || $module eq '') { + fatal('500 Internal Error', + 'You cannot download the top level directory.'); + } - mkdir($tmpexportdir, 0700) - or fatal("500 Internal Error", - 'Unable to make temporary directory: %s', - $!); + unless ($ext eq '.tar.gz' || $ext eq '.tgz') { + fatal('404 Not Found', 'Unsupported archive type.'); + } - my @fatal; + my $tmpexportdir; + eval { + local $SIG{__DIE__}; + # Don't use the CLEANUP argument to tempdir() here, since we might be under + # mod_perl (the process runs for a long time), unlink explicitly later. + $tmpexportdir = tempdir('.cvsweb.XXXXXXXX', TMPDIR => 1); + }; + if ($@) { + fatal('500 Internal Error', 'Unable to make temporary directory: %s', $@); + } + if (!chdir($tmpexportdir)) { + fatal('500 Internal Error', + "Can't cd to temporary directory %s: %s", $tmpexportdir, $!); + } - my $tag = - (exists $input{only_with_tag} && length $input{only_with_tag}) ? - $input{only_with_tag} : "HEAD"; + my @fatal; + my $tag = $input{only_with_tag} || 'HEAD'; + $tag = 'HEAD' if ($tag eq 'MAIN'); - if ($tag eq 'MAIN') { - $tag = 'HEAD'; - } + my @cmd = + ($CMD{cvs}, @cvs_options, '-Qd', $cvsroot, 'export', '-r', $tag, + '-d', $basedir, $module); + my $export_err; + my ($errcode, $err) = runproc(\@cmd, '2>', \$export_err); + if ($errcode) { + @fatal = + ('500 Internal Error', + 'Export failure (exit status %s), output:
%s', + $errcode, $err || $export_err); + } else { + $| = 1; # Essential to get the buffering right. + local (*TAR_OUT); + my ($h, $err) = startproc($CMD{tar}, @tar_options, '-czf', '-', + $basedir, '>pipe', \*TAR_OUT); + if ($h) { + print "Content-Type: application/x-gzip\r\n\r\n"; + local $/ = undef; + print
%s', + $? >> 8 || -1, $err); + } + } - if (system $CMD{cvs}, @cvs_options, '-Qd', $cvsroot, 'export', '-r', - $tag, '-d', "$tmpexportdir/$basedir", $module) - { - @fatal = ("500 Internal Error", - 'cvs co failure: %s: %s', - $!, $module); - } else { - $| = 1; # Essential to get the buffering right. + # Clean up. + chdir(".."); + rmtree($tmpexportdir); - if ($ext eq '.tar.gz') { - print "Content-Type: application/x-gzip\r\n\r\n"; + &fatal(@fatal) if @fatal; - system - "$CMD{tar} @tar_options -cf - -C $tmpexportdir $basedir | $CMD{gzip} @gzip_options -c" - and @fatal = - ("500 Internal Error", - 'tar zc failure: %s: %s', - $!, $basedir); - } elsif ($ext eq '.zip' && $CMD{zip}) { - print "Content-Type: application/zip\r\n\r\n"; - - system - "cd $tmpexportdir && $CMD{zip} @zip_options -r - $basedir" - and @fatal = - ("500 Internal Error", - 'zip failure: %s: %s', - $!, $basedir); - } else { - @fatal = - ("500 Internal Error", - 'unsupported file type'); - } - } - - system $CMD{rm}, '-rf', $tmpexportdir if -d $tmpexportdir; - - &fatal(@fatal) if @fatal; - - exit; + exit; } ############################## # View a directory ############################### if (-d $fullname) { - my $dh = do { local (*DH); }; - opendir($dh, $fullname) or fatal("404 Not Found", - '%s: %s', - $where, $!); - my @dir = readdir($dh); - closedir($dh); - my @subLevelFiles = findLastModifiedSubdirs(@dir) - if ($show_subdir_lastmod); - getDirLogs($cvsroot, $where, @subLevelFiles); - if ($where eq '/') { - html_header($defaulttitle); - $long_intro =~ s/!!CVSROOTdescr!!/$CVSROOTdescr{$cvstree}/g; - print $long_intro; - } else { - html_header($where); - print $short_instruction; - } + my $dh = do { local (*DH); }; + opendir($dh, $fullname) or fatal("404 Not Found", '%s: %s', $where, $!); + my @dir = grep(!forbidden(catfile($fullname, $_)), readdir($dh)); + closedir($dh); + my @subLevelFiles = findLastModifiedSubdirs(@dir) if $show_subdir_lastmod; + my @unreadable = getDirLogs($cvsroot, $where, @subLevelFiles); - if ($use_descriptions && open(DESC, "<$cvsroot/CVSROOT/descriptions")) - { - while (
%s
', $cr);
+ }
+ my @cmd = ($CMD{cvs}, @cvs_options, '-d', $cr, 'co', '-p', "-r$rev",$co);
+ local (*CVS_OUT, *CVS_ERR);
+ my ($h, $err) = startproc(\@cmd, \"", '>pipe', \*CVS_OUT,
+ '2>pipe', \*CVS_ERR);
+ fatal('500 Internal Error', $err) unless $h;
+ if ($html) {
+ local $/ = undef;
+ print \n";
+ while (
';
+ }
+ print "
Current directory: ", &clickablePath($where, 0), - "
\n"; + print "\n"; - print "Current tag: ", $input{only_with_tag},"
\n" - if $input{only_with_tag}; + # give direct access to dirs + if ($where eq '/') { + chooseCVSRoot(); + } else { + print 'Current directory: ', clickablePath($where, 0), ''; + print "
\n"; + print "Current tag: ", htmlquote($input{only_with_tag}), "
\n" + if $input{only_with_tag}; + } - } + print "