===================================================================
RCS file: /cvs/cvsweb/cvsweb.cgi,v
retrieving revision 4.18
retrieving revision 4.38
diff -u -p -r4.18 -r4.38
--- cvsweb/cvsweb.cgi 2019/11/11 14:37:54 4.18
+++ cvsweb/cvsweb.cgi 2019/11/29 19:30:16 4.38
@@ -1,5 +1,5 @@
#!/usr/bin/perl
-# $Id: cvsweb.cgi,v 4.18 2019/11/11 14:37:54 schwarze Exp $
+# $Id: cvsweb.cgi,v 4.38 2019/11/29 19:30:16 schwarze Exp $
# $knu: cvsweb.cgi,v 1.299 2010/11/13 16:37:18 simon
#
# cvsweb - a CGI interface to CVS trees.
@@ -56,34 +56,29 @@ use filetest qw(access);
use vars qw (
$VERSION $CheckoutMagic $MimeTypes $DEBUG
$config $allow_version_select
- @CVSrepositories @CVSROOT %CVSROOT %CVSROOTdescr
- %MIRRORS %DEFAULTVALUE %ICONS %MTYPES
- %DIFF_COMMANDS @DIFFTYPES %DIFFTYPES @LOGSORTKEYS %LOGSORTKEYS
+ @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
- $prcgi @prcategories $re_prcategories $prkeyword $re_prkeyword $mancgi
- $doCheckout $scriptname $scriptwhere
+ $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
- $charset $output_filter
- @command_path %CMD $allow_compress $backicon $diricon $fileicon
- $fullname $cvstreedefault $logo $defaulttitle $address $binfileicon
- $long_intro $short_instruction $shortLogLen $show_author
- $tablepadding $hr_breakable $showfunc $hr_ignwhite $hr_ignkeysubst
- $inputTextSize $mime_types $allow_annotate $allow_markup $allow_mailtos
+ %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 @mytz $dwhere
+ $use_descriptions %descriptions $dwhere
$use_moddate $gzip_open $file_list_len
- $allow_tar @tar_options @gzip_options @zip_options @cvs_options
+ $allow_tar @tar_options @cvs_options
@annotate_options @rcsdiff_options
- $HTML_DOCTYPE $HTML_META $cssurl $CSS $cvshistory_url
- $allow_enscript @enscript_options %enscript_types
+ $HTML_DOCTYPE $HTML_META $cssurl $CSS
);
require Compress::Zlib;
@@ -91,7 +86,7 @@ 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 tempfile);
+use File::Temp qw(tempdir);
use IPC::Run qw();
use Time::Local qw(timegm);
use URI::Escape qw(uri_escape uri_unescape);
@@ -131,6 +126,8 @@ EOM
$MimeTypes = undef if $@;
$CheckoutMagic = '~checkout~';
+ $CMD{$_} = "/usr/bin/$_" for (qw(cvs rcsdiff rlog));
+ $CMD{tar} = "/bin/tar";
}
# -----------------------------------------------------------------------------
@@ -146,18 +143,14 @@ sub spacedHtmlText($;$);
sub link($$);
sub revcmp($$);
sub fatal($$@);
-sub config_error($$);
sub redirect($;$);
sub safeglob($);
sub search_path($);
-sub getEnscriptHL($);
sub getMimeType($;$);
sub head($;$);
sub scan_directives(@);
-sub openOutputFilter();
sub doAnnotate($$);
sub doCheckout($$$);
-sub doEnscript($$$;$);
sub cvswebMarkup($$$$$$;$);
sub viewable($);
sub doDiff($$$$$$);
@@ -172,13 +165,11 @@ sub plural_write($$);
sub readableTime($$);
sub clickablePath($$);
sub chooseCVSRoot();
-sub chooseMirror();
sub fileSortCmp();
sub download_url($$;$);
sub download_link($$$;$);
sub display_url($$;$);
sub display_link($$;$$);
-sub history_link($$;$);
sub toggleQuery($;$);
sub htmlquote($);
sub htmlunquote($);
@@ -190,28 +181,31 @@ sub link_tags($);
sub forbidden($);
sub startproc(@);
sub runproc(@);
-sub checkout_to_temp($$$);
# Get rid of unsafe environment vars. Don't do this in the BEGIN block
# (think mod_perl)...
delete(@ENV{qw(PATH IFS CDPATH ENV BASH_ENV)});
+# Helps to achieve read only access to the repositories
+# with cvs >= 1.12.1 and doesn't hurt other versions.
+$ENV{CVSREADONLYFS} = 1;
+
# Location of the configuration file inside the web server chroot:
$config = '/conf/cvsweb/cvsweb.conf';
######## Configuration parameters #########
-@CVSrepositories = @CVSROOT = %CVSROOT = %MIRRORS = %DEFAULTVALUE = %ICONS =
- %MTYPES = %tags = %alltags = %fileinfo = %DIFF_COMMANDS = ();
+@CVSrepositories = @CVSROOT = %CVSROOT = %DEFAULTVALUE =
+ %MTYPES = %tags = %alltags = %fileinfo = ();
-$cvstreedefault = $logo = $defaulttitle =
- $address = $long_intro = $short_instruction = $shortLogLen = $show_author =
- $tablepadding = $hr_breakable = $showfunc = $hr_ignwhite =
- $hr_ignkeysubst = $inputTextSize = $mime_types = $allow_annotate =
+$logo = $defaulttitle =
+ $address = $shortLogLen = $show_author =
+ $hr_breakable = $hr_ignwhite =
+ $hr_ignkeysubst = $mime_types = $allow_annotate =
$allow_markup = $allow_compress = $edit_option_form =
$show_subdir_lastmod = $show_log_in_markup = $preformat_in_markup =
$tabstop = $use_moddate = $gzip_open = $DEBUG =
- $cvshistory_url = $allow_tar = undef;
+ $allow_tar = undef;
$allow_version_select = $allow_mailtos = $allow_log_extra = 1;
@@ -267,7 +261,7 @@ $scriptname = '' unless defined($scriptname);
$where = $pathinfo;
$doCheckout = $where =~ s|^/$CheckoutMagic/|/|o;
$where =~ s|^/||;
-$scriptname =~ s|^/*|/|;
+$scriptname =~ s|^/+||;
# Let's workaround thttpd's stupidity..
if ($scriptname =~ m|/$|) {
@@ -275,6 +269,7 @@ if ($scriptname =~ m|/$|) {
my $re = quotemeta $pathinfo;
$scriptname =~ s/$re$//;
}
+$scriptname = "/$scriptname" if $scriptname;
# $scriptname : the URI escaped path to this script
# $where : the path in the CVS repository (without leading /, or only /)
@@ -319,14 +314,18 @@ $maycompress = (
qw(cvsroot hideattic ignorecase sortby logsort f only_with_tag ln
hidecvsroot hidenonreadable);
-#
# Load configuration.
-#
-if (-f $config) {
- do "$config" or config_error($config, $@);
-} else {
- fatal("500 Internal Error",
- 'Configuration not found. Set the parameter $config
in cvsweb.cgi to your cvsweb.conf configuration file first.');
+{
+ $config =~ m|^/| or fatal '500 Internal Error',
+ 'Configuration file name "%s
" is not an absolute path.',
+ $config;
+ defined do $config and last;
+ $@ and fatal '500 Internal Error',
+ 'Error loading configuration file "%s
":
%s', + $config, $@; + fatal '500 Internal Error', + 'Cannot read configuration file "
%s
": %s',
+ $config, $! || 'unknown error';
}
# Try to find a readable dir where we can cd into. Some abs_path()
@@ -473,7 +472,6 @@ for (my $i = 0; $i < scalar(@CVSrepositories); $i += 2
next;
}
$rootfound ||= 1;
- $cvstreedefault = $key unless defined($cvstreedefault);
$CVSROOTdescr{$key} = $descr;
$CVSROOT{$key} = $root;
push(@CVSROOT, $key);
@@ -486,20 +484,8 @@ unless ($rootfound) {
}
undef $rootfound;
-#
-# Default CVS root
-#
-if (!defined($CVSROOT{$cvstreedefault})) {
- fatal("500 Internal Error",
- '$cvstreedefault
points to a repository (%s) not ' .
- 'defined in @CVSrepositories
in your configuration ' .
- 'file (%s
).',
- $cvstreedefault,
- $config);
-}
+$DEFAULTVALUE{cvsroot} = $CVSrepositories[0];
-$DEFAULTVALUE{cvsroot} = $cvstreedefault;
-
while (my ($key, $defval) = each %DEFAULTVALUE) {
# Replace not given parameters with defaults.
@@ -534,27 +520,6 @@ foreach (@stickyvars) {
}
}
-if ($allow_enscript) {
- push(@DIFFTYPES, qw(uc cc));
- @DIFFTYPES{qw(uc cc)} = (
- {
- 'descr' => 'unified, colored',
- 'opts' => ['-u'],
- 'colored' => 0,
- },
- {
- 'descr' => 'context, colored',
- 'opts' => ['-c'],
- 'colored' => 0,
- },
- );
-} else {
- # No Enscript -> respect difftype, but don't offer colorization.
- if ($input{f} && $input{f} =~ /^([ucs])c$/) {
- $input{f} = $1;
- }
-}
-
# is there any query ?
if (@barequery) {
$barequery = join (';', @barequery);
@@ -598,22 +563,25 @@ $logsort = $input{logsort};
if ($input{cvsroot} && $CVSROOT{$input{cvsroot}}) {
$cvstree = $input{cvsroot};
} else {
- $cvstree = $cvstreedefault;
+ $cvstree = $CVSrepositories[0];
}
$cvsroot = $CVSROOT{$cvstree};
-# create icons out of description
-foreach my $k (keys %ICONS) {
- my ($itxt, $ipath, $iwidth, $iheight) = @{$ICONS{$k}};
- no strict 'refs';
- if ($ipath) {
- ${"${k}icon"} =
- sprintf('',
- htmlquote($ipath), htmlquote($itxt), $iwidth, $iheight);
- } else {
- ${"${k}icon"} = $itxt;
- }
+if ($iconsdir) {
+ $backicon = '';
+ $diricon = '';
+ $fileicon = '';
+ $binfileicon = '';
+} else {
+ $backicon = 'back';
+ $diricon = 'dir';
+ $fileicon = 'file';
+ $binfileicon = 'binfile';
}
my $config_cvstree = "$config-$cvstree";
@@ -627,10 +595,6 @@ if (-f $config_cvstree) {
}
undef $config_cvstree;
-$re_prcategories = '(?:' . join ('|', @prcategories) . ')' if @prcategories;
-$re_prkeyword = quotemeta($prkeyword) if defined($prkeyword);
-$prcgi .= '%s' if defined($prcgi) && $prcgi !~ /%s/;
-
$fullname = catfile($cvsroot, $where);
my $rewrite = 0;
@@ -676,7 +640,7 @@ if ($input{tarball}) {
my ($module) = ($where =~ m,^/?(.*),); # untaint
$module =~ s,/([^/]*)$,,;
- my ($ext) = ($1 =~ /(\.t(?:ar\.)?gz|\.zip)$/);
+ my ($ext) = ($1 =~ /(\.t(?:ar\.)?gz)$/);
my ($basedir) = ($module =~ m,([^/]+)$,);
if ($basedir eq '' || $module eq '') {
@@ -684,18 +648,9 @@ if ($input{tarball}) {
'You cannot download the top level directory.');
}
- my $istar = ($ext eq '.tar.gz' || $ext eq '.tgz');
- if ($istar) {
- fatal('500 Internal Error', 'tar command not found.') unless $CMD{tar};
- fatal('500 Internal Error', 'gzip command not found.') unless $CMD{gzip};
+ unless ($ext eq '.tar.gz' || $ext eq '.tgz') {
+ fatal('404 Not Found', 'Unsupported archive type.');
}
- my $iszip = ($ext eq '.zip');
- if ($iszip && !$CMD{zip}) {
- fatal('500 Internal Error', 'zip command not found.');
- }
- if (!$istar && !$iszip) {
- fatal('500 Internal Error', 'Unsupported archive type.');
- }
my $tmpexportdir;
eval {
@@ -726,35 +681,20 @@ if ($input{tarball}) {
('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 (@cmd, $ctype); - if ($istar) { - my @tar = ($CMD{tar}, @tar_options, '-cf', '-', $basedir); - my @gzip = ($CMD{gzip}, @gzip_options, '-c'); - push(@cmd, \@tar, '|', \@gzip); - $ctype = 'application/x-gzip'; - } elsif ($iszip) { - my @zip = ($CMD{zip}, @zip_options, '-r', '-', $basedir); - push(@cmd, \@zip, \''); - $ctype = 'application/zip'; - } - push(@cmd, '>pipe', \*TAR_OUT); - - my ($h, $err) = startproc(@cmd); + my ($h, $err) = startproc($CMD{tar}, @tar_options, '-czf', '-', + $basedir, '>pipe', \*TAR_OUT); if ($h) { - print "Content-Type: $ctype\r\n\r\n"; + print "Content-Type: application/x-gzip\r\n\r\n"; local $/ = undef; print
%s', - $istar ? 'Tar' : 'Zip', $? >> 8 || -1, $err); + 'tar failure (exit status %s), output:
%s', + $? >> 8 || -1, $err); } } @@ -781,8 +721,6 @@ if (-d $fullname) { if ($where eq '/') { html_header($defaulttitle); - $long_intro =~ s/!!CVSROOTdescr!!/$CVSROOTdescr{$cvstree}/g; - print $long_intro; } else { html_header($where); my $html = (-f catfile($fullname, 'README.cvs.html,v') || @@ -819,7 +757,6 @@ if (-d $fullname) { } $h->finish(); } - print $short_instruction; } if ($use_descriptions && @@ -836,15 +773,9 @@ if (-d $fullname) { # give direct access to dirs if ($where eq '/') { - chooseMirror(); chooseCVSRoot(); - } else { print '
Current directory: ', clickablePath($where, 0), ''; - if ($cvshistory_url) { - (my $d = $where) =~ s|^/*(.*?)/*$|$1|; - print ' - ', history_link($d, ''); - } print "
\n"; print "Current tag: ", htmlquote($input{only_with_tag}), "
\n" if $input{only_with_tag}; @@ -854,8 +785,8 @@ if (-d $fullname) { my $infocols = 1; - printf(<\n"; my $linenumbers = $input{ln} || 0; - - if (my $enscript_hl = getEnscriptHL($filename)) { - doEnscript($filehandle, $enscript_hl, $linenumbers); - - } else { my $ln = 0; my @buf = (); my $ts = undef; @@ -2157,8 +1993,6 @@ EOF } print $preformat_in_markup ? spacedHtmlText($_, $ts) : htmlquote($_); } - } - print "\n"; } html_footer(); @@ -2214,60 +2048,6 @@ sub doDiff($$$$$$) my $mimetype = getMimeType($fullname); - # - # Check for per-MIME type diff commands. - # - my $diffcmd = undef; - if (my $diffcmds = $DIFF_COMMANDS{lc($mimetype)}) { - if ($f =~ /^ext(\d*)$/) { - my $n = $1 || 0; - $diffcmd = $diffcmds->[$n]; - } - } - if ($diffcmd && $diffcmd->{cmd} && $diffcmd->{name}) { - - if ($diffcmd->{args} && ref($diffcmd->{args}) ne 'ARRAY') { - fatal('500 Internal Error', - 'Configuration error: arguments to external diff tools must ' . - 'be given as array refs. See "
%s
" in ' .
- '%%DIFF_COMMANDS
.',
- $diffcmd->{name});
- }
-
- (my $cvsname = $where) =~ s/\.diff$//;
-
- # Create two temporary files with the two revisions
- my $temp_fn1 = checkout_to_temp($cvsroot, $cvsname, $rev1);
- my $temp_fn2 = checkout_to_temp($cvsroot, $cvsname, $rev2);
-
- # Execute chosen diff binary.
- local (*DIFF_OUT);
- my @cmd = ($diffcmd->{cmd});
- push(@cmd, @{$diffcmd->{args}}) if $diffcmd->{args};
- push(@cmd, $temp_fn1, $temp_fn2);
- my ($h, $err) = startproc(\@cmd, \"", '>pipe', \*DIFF_OUT);
- if (!$h) {
- unlink($temp_fn1);
- unlink($temp_fn2);
- fatal('500 Internal Error',
- 'Diff failure (exit status %s), output: %s', - $? >> 8 || -1, $err); - } - - http_header($diffcmd->{type} || 'text/plain'); - local $/ = undef; - print
-EOF - doEnscript(\$fh, $hl, 0, 'cvsweb_diff'); - print <-
-\n"; - html_footer(); - gzipclose(); - exit; - } else { # # Plain diff. @@ -2425,7 +2174,6 @@ sub getDirLogs($$@) my $fh = do { local (*FH); }; if (!open($fh, '-|')) { # Child open(STDERR, '>', devnull()) unless $DEBUG; # Ignore rlog's complaints. - openOutputFilter(); if ($file_list_len && $file_list_len > 1) { while (scalar(@files) > $file_list_len) { # Process files in chunks. system(@cmd, splice(@files, 0, $file_list_len)) == 0 or exit -1; @@ -2579,10 +2327,9 @@ sub getDirLogs($$@) if ($linesread == 0) { fatal('500 Internal Error', - 'Failed to spawn GNU rlog on "%s".
Did you set the@command_path
in your configuration file correctly? (Currently: "%s
")', - htmlquote(join(', ', @files)), join(':', @command_path)); + 'Failed to spawn rlog on "%s"', + htmlquote(join(', ', @files))); } - return @unreadable; } @@ -2604,7 +2351,6 @@ sub readLog($;$) my $fh = do { local (*FH); }; if (!open($fh, "-|")) { # child - openOutputFilter(); $revision = defined($revision) ? "-r$revision" : ''; if ($revision =~ /\./) { # Normal revision, not a branch/tag name. @@ -2830,13 +2576,6 @@ sub getDiffLinks($$$) &link(htmlquote(lc($DIFFTYPES{$difftype}{descr})), "$url;f=$f")); } } - if (my $extdiffs = $DIFF_COMMANDS{lc($mimetype)}) { - for my $i (0 .. scalar(@$extdiffs)-1) { - my $extdiff = $extdiffs->[$i]; - push(@links, &link(htmlquote($extdiff->{name}), "$url;f=ext$i")) - if ($extdiff->{cmd} && $extdiff->{name}); - } - } return @links; } @@ -2902,12 +2641,7 @@ sub printLog($$$;$$) print "
\n"; print ''; - if (@mytz) { - my ($est) = $mytz[(localtime($date{$_}))[8]]; - print scalar localtime($date{$_}), " $est ("; - } else { - print scalar gmtime($date{$_}), " UTC ("; - } + print scalar gmtime($date{$_}), ' UTC ('; print readableTime(time() - $date{$_}, 1), ' ago)'; print ' by ', htmlquote($author{$_}), "
\n"; @@ -3054,10 +2788,6 @@ sub doLog($) &clickablePath($upwhere, 1), "\n\n"; print "\n "; print &link('Request diff between arbitrary revisions', '#diff'); - if ($cvshistory_url) { - (my $d = $upwhere) =~ s|/+$||; - print ' - ', history_link($d, $filename); - } print "\n
\n
\n"; print "\n"; @@ -3121,8 +2851,8 @@ EOF my $diffrev = defined($input{r1}) ? $input{r1} : $revdisplayorder[$#revdisplayorder]; - printf(<
+ printf(<
\nThis CVSweb is mirrored in\n"; - - my @tmp = map(&link(htmlquote($_), $MIRRORS{$_}), sort keys %MIRRORS); - my $tmp = pop (@tmp); - - if (scalar(@tmp)) { - print join (', ', @tmp), ' and '; - } - - print "$tmp.\n
\n"; -} - - sub fileSortCmp() { (my $af = $a) =~ s/,v$//; @@ -3820,21 +3499,6 @@ sub display_link($$;$$) htmlquote($textlink)); } -# -# Returns a link to CVSHistory for the given directory and filename. -# -sub history_link($$;$) -{ - my ($dir, $file, $text) = @_; - $dir ||= ''; - $file ||= ''; - $text ||= 'History'; - return &link($text, - sprintf('%s?cvsroot=%s;dsearch=%s;fsearch=%s;limit=1', - $cvshistory_url, uri_escape($input{cvsroot} || ''), - uri_escape($dir), uri_escape($file))); -} - # Returns a Query string with the # specified parameter toggled sub toggleQuery($;$) @@ -3899,10 +3563,8 @@ sub http_header(;$$) { my ($content_type, $moddate) = @_; $content_type ||= 'text/html'; + $content_type .= '; charset="UTF-8"' if $content_type =~ /^text\//; - $content_type .= "; charset=$charset" - if ($charset && $content_type =~ m,^text/,); - # Note that in the following, we explicitly join() and concatenate the # headers instead of printing them as an array. This is because some # systems, eg. early versions of mod_perl 2 don't quite get it if the @@ -4028,37 +3690,6 @@ sub runproc(@) $errormsg = "'@{$_[0]}' failed: $@"; } return ($exitcode, $errormsg); -} - -# -# Check out a file to a temporary file. -# -sub checkout_to_temp($$$) -{ - my ($cvsroot, $cvsname, $rev) = @_; - - # Pipe given cvs file into a temporary place. - my ($temp_fh, $temp_fn) = tempfile('.cvsweb.XXXXXXXX', DIR => tmpdir()); - - my @cmd = ($CMD{cvs}, @cvs_options, '-Qd', $cvsroot, - 'co', '-p', "-r$rev", $cvsname); - - local (*DIFF_OUT); - my ($h, $err) = startproc(\@cmd, \"", '>pipe', \*DIFF_OUT); - if ($h) { - local $/ = undef; - print $temp_fh%s', - $? >> 8 || -1, $err); - } - - return $temp_fn; } #