===================================================================
RCS file: /cvs/cvsweb/cvsweb.cgi,v
retrieving revision 1.1.1.16
retrieving revision 1.1.1.27
diff -u -p -r1.1.1.16 -r1.1.1.27
--- cvsweb/cvsweb.cgi 2000/12/28 18:37:25 1.1.1.16
+++ cvsweb/cvsweb.cgi 2001/07/06 09:54:57 1.1.1.27
@@ -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,21 +42,25 @@
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.
#
-# $zId: cvsweb.cgi,v 1.104 2000/11/01 22:05:12 hnordstrom Exp $
-# $kId: cvsweb.cgi,v 1.47 2000/12/28 18:07:20 knu Exp $
+# $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 $
#
###
+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
@@ -64,7 +68,8 @@ use vars qw (
%input $query $barequery $sortby $bydate $byrev $byauthor
$bylog $byfile $defaultDiffType $logsort $cvstree $cvsroot
$mimetype $charset $defaultTextPlain $defaultViewable
- $allow_compress $GZIPBIN $backicon $diricon $fileicon
+ $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
@@ -75,11 +80,12 @@ 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 $v
+ $show_subdir_lastmod $show_log_in_markup $preformat_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
+ $use_moddate $has_zlib $gzip_open
+ $allow_tar @tar_options @gzip_options @zip_options @cvs_options
$LOG_FILESEPARATOR $LOG_REVSEPARATOR
);
@@ -95,6 +101,7 @@ sub revcmp($$);
sub fatal($$);
sub redirect($);
sub safeglob($);
+sub search_path($);
sub getMimeTypeFromSuffix($);
sub head($;$);
sub scan_directives(@);
@@ -122,6 +129,7 @@ sub toggleQuery($$);
sub urlencode($);
sub htmlquote($);
sub htmlunquote($);
+sub hrefquote($);
sub http_header(;$);
sub html_header($);
sub html_footer();
@@ -129,16 +137,26 @@ sub link_tags($);
sub forbidden_module($);
##### Start of Configuration Area ########
-use Cwd;
+delete $ENV{PATH};
+$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 (
- $ENV{CVSWEB_CONFIG},
- '/usr/local/etc/cvsweb.conf',
- getcwd() . '/cvsweb.conf'
+ "$mydir/cvsweb.conf",
+ '/usr/local/etc/cvsweb/cvsweb.conf'
) {
- $config = $_ if defined($_) && -r $_;
+ if (defined($_) && -r $_) {
+ $config = $_;
+ last;
+ }
}
# == Configuration defaults ==
@@ -150,8 +168,9 @@ $allow_version_select = 1;
######## Configuration variables #########
# These are defined to allow checking with perl -cw
-%CVSROOT = %MIRRORS = %DEFAULTVALUE = %ICONS = %MTYPES =
-%tags = %alltags = @tabcolors = ();
+@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 =
@@ -228,18 +247,23 @@ $verbose = $v;
$checkoutMagic = "~checkout~";
$pathinfo = defined($ENV{PATH_INFO}) ? $ENV{PATH_INFO} : '';
$where = $pathinfo;
-$where =~ tr|/|/|s;
-$doCheckout = ($where =~ /^\/$checkoutMagic/);
-$where =~ s|^/($checkoutMagic)?||;
-$where =~ s|/$||;
+$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
@@ -278,16 +302,14 @@ $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, or the environment variable '
- . 'CVSWEB_CONFIG
, to your cvsweb.conf '
- . 'configuration file first.');
+ . 'in cvsweb.cgi to your cvsweb.conf configuration file first.');
}
undef %input;
@@ -354,6 +376,10 @@ else {
}
undef @barequery;
+if (defined($input{path})) {
+ redirect("$scriptname/$input{path}$query");
+}
+
# get actual parameters
$sortby = $input{"sortby"};
$bydate = 0;
@@ -381,7 +407,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",
@@ -418,49 +459,45 @@ my $config_cvstree = "$config-$cvstree";
# Do some special configuration for cvstrees
if (-f $config_cvstree) {
- do $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;
+$fullname = "$cvsroot/$where";
$mimetype = &getMimeTypeFromSuffix ($fullname);
$defaultTextPlain = ($mimetype eq "text/plain");
$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.');
}
@@ -480,11 +517,12 @@ 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($ext) = ($1 =~ /(\.tar\.gz|\.zip)$/);
+ 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.");
}
@@ -493,40 +531,34 @@ if ($input{tarball}) {
mkdir($tmpdir, 0700)
or &fatal("500 Internal Error", "Unable to make temporary directory: $!");
- my $fatal = '';
+ my @fatal;
- do {
- chdir $tmpdir
- or $fatal = "500 Internal Error", "Unable to cd to temporary directory: $!"
- && last;
+ my $tag = (exists $input{only_with_tag} && length $input{only_with_tag})
+ ? $input{only_with_tag} : "HEAD";
- my @params = (exists $input{only_with_tag} && length $input{only_with_tag})
- ? ("-r", $input{only_with_tag}) : ();
-
- system "cvs", "-RlQd", $cvsroot, "co", @params, $where
- and $fatal = "500 Internal Error","cvs co failure: $!: $where"
- && last;
-
- chdir "$where/.."
- or $fatal = "500 Internal Error","Cannot find expected directory in checkout"
- && last;
-
+ 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.
- print "Content-type: application/x-gzip\r\n\r\n";
+ if ($ext eq '.tar.gz') {
+ print "Content-type: application/x-gzip\r\n\r\n";
- system "tar", "--ignore-failed-read", "--exclude", "CVS", "-zcf", "-", $basedir
- and $fatal = "500 Internal Error","tar zc failure: $!: $basedir"
- && last;
+ 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";
- chdir $tmpdir
- or $fatal = "500 Internal Error","Unable to cd to temporary directory: $!"
- && last;
- } while (0);
+ 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 "rm", "-rf", $tmpdir if -d $tmpdir;
+ system $CMD{rm}, '-rf', $tmpdir if -d $tmpdir;
- &fatal($fatal) if $fatal;
+ &fatal(@fatal) if @fatal;
exit;
}
@@ -709,7 +741,8 @@ if (-d $fullname) {
if ($_ eq '..' || -d "$fullname/$_") {
next if ($_ eq '..' && $where eq '/');
- my ($rev,$date,$log,$author,$filename) = @{$fileinfo{$_}}
+ my ($rev,$date,$log,$author,$filename);
+ ($rev,$date,$log,$author,$filename) = @{$fileinfo{$_}}
if (defined($fileinfo{$_}));
printf '
', $tabcolors[$dirrow % 2] if $dirtable;
if ($_ eq '..') {
@@ -720,10 +753,10 @@ if (-d $fullname) {
else {
print &link($backicon, $url);
}
- print " ", &link("Previous Directory", $url);
+ print " ", &link("Parent Directory", $url);
}
else {
- $url = urlencode($_) . "/$query";
+ $url = './' . urlencode($_) . "/$query";
print " ";
if ($nofilelinks) {
print $diricon;
@@ -786,7 +819,7 @@ if (-d $fullname) {
}
elsif (s/,v$//) {
$fileurl = ($attic ? "Attic/" : "") . urlencode($_);
- $url = $fileurl . $query;
+ $url = './' . $fileurl . $query;
my $rev = '';
my $date = '';
my $log = '';
@@ -869,6 +902,8 @@ if (-d $fullname) {
">$tag\n";
}
print "\n";
+ print " Module path or alias:\n";
+ printf " \n", htmlquote($where);
print " \n";
print "\n";
}
@@ -876,15 +911,21 @@ 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",
- # Mangle the filename so browsers show a reasonable
- # filename to download.
- "$basefile.tar.gz$query".
- ($query ? "&" : "?")."tarball=1"),
- "
";
+ "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 "
";
}
}
@@ -971,7 +1012,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"))) {
@@ -987,11 +1028,11 @@ if (-d $fullname) {
# Assume it's a module name with a potential path following it.
$xtra = (($module = $where) =~ s|/.*||) ? $& : '';
# Is there an indexed version of modules?
- if (open($fh, "$cvsroot/CVSROOT/modules")) {
+ if (open($fh, "< $cvsroot/CVSROOT/modules")) {
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");
}
}
}
@@ -1076,11 +1117,11 @@ sub findLastModifiedSubdirs(@) {
sub htmlify_sub(&$) {
(my $proc, local $_) = @_;
- local @_ = split(m`(]+>[^<]* )`i);
+ my @a = split(m`(]+>[^<]* )`i);
my $linked;
my $result = '';
- while (($_, $linked) = splice(@_, 0, 2)) {
+ while (($_, $linked) = splice(@a, 0, 2)) {
&$proc();
$result .= $_ if defined($_);
$result .= $linked if defined($linked);
@@ -1112,7 +1153,7 @@ sub htmlify($;$) {
if ($extra) {
# get PR #'s as link: "PR#nnnn" "PR: nnnn, ..." "PR nnnn, ..." "bin/nnnn"
- if (defined($prcgi)) {
+ if (defined($prcgi) && defined($re_prcategories) && defined($re_prkeyword)) {
my $prev;
do {
@@ -1120,7 +1161,7 @@ sub htmlify($;$) {
$_ = htmlify_sub {
s{
- (\bPR[:\#]?\s*
+ (\b$re_prkeyword[:\#]?\s*
(?:
\#?
\d+[,\s]\s*
@@ -1135,7 +1176,7 @@ sub htmlify($;$) {
$_ = htmlify_sub {
s{
- (\b$prcategories/(\d+)\b)
+ (\b$re_prcategories/(\d+)\b)
}{
&link($1, sprintf($prcgi, $2))
}egox;
@@ -1146,7 +1187,7 @@ sub htmlify($;$) {
if (defined($mancgi)) {
$_ = htmlify_sub {
s{
- (\b([a-zA-Z][\w_.]+)
+ (\b([a-zA-Z][\w.]+)
(?:
\( ([0-9n]) \)\B
|
@@ -1154,7 +1195,7 @@ sub htmlify($;$) {
)
)
}{
- &link($1, sprintf($mancgi, $3 ne '' ? $3 : $4, $2))
+ &link($1, sprintf($mancgi, defined($3) ? $3 : $4, $2))
}egx;
} $_;
}
@@ -1194,9 +1235,11 @@ sub spacedHtmlText($;$) {
}
sub link($$) {
- my($name, $where) = @_;
+ my($name, $url) = @_;
- sprintf '%s ', hrefquote($where), $name;
+ $url =~ s/:/sprintf("%%%02x", ord($&))/eg if $url =~ /^[^a-z]/; # relative
+
+ sprintf '%s ', hrefquote($url), $name;
}
sub revcmp($$) {
@@ -1273,11 +1316,23 @@ sub safeglob($) {
push(@results, "$dirname/" .$_);
}
}
+ closedir($dh);
}
@results;
}
+sub search_path($) {
+ my($command) = @_;
+ my $d;
+
+ for $d (split(/:/, $command_path)) {
+ return "$d/$command" if -x "$d/$command";
+ }
+
+ '';
+}
+
sub getMimeTypeFromSuffix($) {
my ($fullname) = @_;
my ($mimetype, $suffix);
@@ -1351,7 +1406,7 @@ sub doAnnotate($$) {
my $reader = do {local(*FH);};
my $writer = do {local(*FH);};
- # make sure the revisions a wellformed, for security
+ # make sure the revisions are wellformed, for security
# reasons ..
if ($rev =~ /[^\w.]/) {
&fatal("404 Not Found",
@@ -1370,8 +1425,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 -Rl server") || fatal ("500 Internal Error",
- "Fatal Error - unable to open cvs for annotation");
+ $pid = open2($reader, $writer, $CMD{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
@@ -1562,8 +1617,8 @@ sub doCheckout($$) {
#
# Safely for a child process to read from.
if (! open($fh, "-|")) { # child
- open(STDERR, ">&STDOUT"); # Redirect stderr to stdout
- exec("cvs", "-Rld", $cvsroot, "co", "-p", $revopt, $where);
+ open(STDERR, ">&STDOUT"); # Redirect stderr to stdout
+ exec($CMD{cvs}, @cvs_options, '-d', $cvsroot, 'co', '-p', $revopt, $where);
}
if (eof($fh)) {
@@ -1578,6 +1633,7 @@ sub doCheckout($$) {
# Parse CVS header
my ($revision, $filename, $cvsheader);
+ $filename = "";
while(<$fh>) {
last if (/^\*\*\*\*/);
$revision = $1 if (/^VERS: (.*)$/);
@@ -1645,7 +1701,7 @@ sub cvswebMarkup($$$) {
elsif ($mimetype =~ m%^application/pdf%) {
printf ' ', hrefquote("$url$barequery");
}
- else {
+ elsif ($preformat_in_markup) {
print "";
# prefetch several lines
@@ -1660,6 +1716,13 @@ sub cvswebMarkup($$$) {
}
print " ";
}
+ else {
+ print "";
+ while (<$filehandle>) {
+ print htmlquote($_);
+ }
+ print " ";
+ }
}
sub viewable($) {
@@ -1725,7 +1788,7 @@ sub doDiff($$$$$$) {
while (($re1, $re2) = each %funcline_regexp) {
if ($fullname =~ /$re1/) {
- push @difftype, '-F', '$re2';
+ push @difftype, '-F', $re2;
last;
}
}
@@ -1740,7 +1803,7 @@ sub doDiff($$$$$$) {
}
if (! open($fh, "-|")) { # child
open(STDERR, ">&STDOUT"); # Redirect stderr to stdout
- exec("rcsdiff",@difftype,"-r$rev1","-r$rev2",$fullname);
+ exec($CMD{rcsdiff}, @difftype, "-r$rev1", "-r$rev2", $fullname);
}
if ($human_readable) {
http_header();
@@ -1821,32 +1884,30 @@ sub getDirLogs($$@) {
return;
}
- if ($tag) {
+ if (defined($tag)) {
#can't use -r as - is allowed in tagnames, but misinterpreated by rlog..
if (! open($fh, "-|")) {
- open(STDERR, '>/dev/null'); # rlog may complain; ignore.
- exec('rlog', @files);
+ open(STDERR, '>/dev/null'); # rlog may complain; ignore.
+ exec($CMD{rlog}, @files);
}
}
else {
- my $kidpid = open($fh, "-|");
- if (! $kidpid) {
- open(STDERR, '>/dev/null'); # rlog may complain; ignore.
- exec('rlog', '-r', @files);
+ if (! open($fh, "-|")) {
+ open(STDERR, '>/dev/null'); # rlog may complain; ignore.
+ exec($CMD{rlog}, '-r', @files);
}
}
$state = "start";
while (<$fh>) {
if ($state eq "start") {
#Next file. Initialize file variables
- $rev = undef;
- $revwanted = undef;
- $branch = undef;
- $branchpoint = undef;
- $filename = undef;
- $log = undef;
- $revision = undef;
- $branch = undef;
+ $rev = '';
+ $revwanted = '';
+ $branch = '';
+ $branchpoint = '';
+ $filename = '';
+ $log = '';
+ $revision = '';
%symrev = ();
@filetags = ();
#jump to head state
@@ -1865,7 +1926,7 @@ again:
$branch = $1
} elsif (/^symbolic names:/) {
$state = "tags";
- ($branch = $head) =~ s/\.\d+$// if (!defined($branch));
+ ($branch = $head) =~ s/\.\d+$// if $branch eq '';
$branch =~ s/(\d+)$/0.$1/;
$symrev{MAIN} = $branch;
$symrev{HEAD} = $branch;
@@ -1874,9 +1935,9 @@ again:
push (@filetags, "MAIN", "HEAD");
} elsif (/$LOG_REVSEPARATOR/o) {
$state = "log";
- $rev = undef;
- $date = undef;
- $log = "";
+ $rev = '';
+ $date = '';
+ $log = '';
# Try to reconstruct the relative filename if RCS spits out a full path
$filename =~ s%^\Q$DirName\E/%%;
}
@@ -1894,7 +1955,7 @@ again:
$revwanted = $symrev{$tag eq "HEAD" ? "MAIN" : $tag};
($branch = $revwanted) =~ s/\b0\.//;
($branchpoint = $branch) =~ s/\.?\d+$//;
- $revwanted = undef if ($revwanted ne $branch);
+ $revwanted = '' if ($revwanted ne $branch);
} elsif ($tag ne "HEAD") {
print "Tag not found, skip this file" if ($verbose);
$state = "skip";
@@ -1911,19 +1972,19 @@ again:
if ($state eq "log") {
if (/$LOG_REVSEPARATOR/o || /$LOG_FILESEPARATOR/o) {
# End of a log entry.
- my $revbranch;
- ($revbranch = $rev) =~ s/\.\d+$//;
+ my $revbranch = $rev;
+ $revbranch =~ s/\.\d+$//;
print "$filename $rev Wanted: $revwanted ",
"Revbranch: $revbranch Branch: $branch ",
"Branchpoint: $branchpoint\n" if ($verbose);
- if (!defined($revwanted) && defined($branch)
+ if ($revwanted eq '' && $branch ne ''
&& $branch eq $revbranch || !defined($tag)) {
print "File revision $rev found for branch $branch\n"
if ($verbose);
$revwanted = $rev;
}
- if (defined($revwanted) ? $rev eq $revwanted :
- defined($branchpoint) ? $rev eq $branchpoint :
+ if ($revwanted ne '' ? $rev eq $revwanted :
+ $branchpoint ne '' ? $rev eq $branchpoint :
0 && ($rev eq $head)) { # Don't think head is needed here..
print "File info $rev found for $filename\n" if ($verbose);
my @finfo = ($rev,$date,$log,$author,$filename);
@@ -1932,11 +1993,11 @@ again:
$fileinfo{$name} = [ @finfo ];
$state = "done" if ($rev eq $revwanted);
}
- $rev = undef;
- $date = undef;
- $log = "";
+ $rev = '';
+ $date = '';
+ $log = '';
}
- elsif (!defined($date) && m|^date:\s+(\d+)/(\d+)/(\d+)\s+(\d+):(\d+):(\d+);|) {
+ elsif ($date eq '' && m|^date:\s+(\d+)/(\d+)/(\d+)\s+(\d+):(\d+):(\d+);|) {
my $yr = $1;
# damn 2-digit year routines :-)
if ($yr > 100) {
@@ -1948,7 +2009,7 @@ again:
$log = '';
next;
}
- elsif (!defined($rev) && m/^revision (.*)$/) {
+ elsif ($rev eq '' && /^revision (.*)$/) {
$rev = $1;
next;
}
@@ -1963,7 +2024,7 @@ again:
}
if ($. == 0) {
fatal("500 Internal Error",
- "Failed to spawn GNU rlog on '".join(", ", @files)."' did you set the \$ENV{PATH} in your configuration file correctly ?");
+ "Failed to spawn GNU rlog on '".join(", ", @files)."'
Did you set the \$command_path in your configuration file correctly ? (Currently '$command_path'");
}
close($fh);
}
@@ -1991,12 +2052,12 @@ sub readLog($;$) {
print("Going to rlog '$fullname'\n") if ($verbose);
if (! open($fh, "-|")) { # child
- if ($revision ne '') {
- exec("rlog",$revision,$fullname);
- }
- else {
- exec("rlog",$fullname);
- }
+ if ($revision ne '') {
+ exec($CMD{rlog}, $revision, $fullname);
+ }
+ else {
+ exec($CMD{rlog}, $fullname);
+ }
}
while (<$fh>) {
print if ($verbose);
@@ -2356,18 +2417,18 @@ sub printLog($;$) {
if (/^\d+\.\d+\.\d+/ && !/^1\.1\.1\.\d+$/) {
my ($i,$nextmain);
for ($i = 0; $i < $#revorder && $revorder[$i] ne $_; $i++){}
- my (@tmp2) = split(/\./, $_);
+ my @tmp2 = split(/\./, $_);
for ($nextmain = ""; $i > 0; $i--) {
- my ($next) = $revorder[$i-1];
- my (@tmp1) = split(/\./, $next);
- if ($#tmp1 < $#tmp2) {
+ my $next = $revorder[$i-1];
+ my @tmp1 = split(/\./, $next);
+ if (@tmp1 < @tmp2) {
$nextmain = $next;
last;
}
# Only the highest version on a branch should have
# a diff for the "next main".
- last if (join(".",@tmp1[0..$#tmp1-1])
- eq join(".",@tmp2[0..$#tmp1-1]));
+ last if (@tmp1 - 1 <= @tmp2 &&
+ join(".",@tmp1[0..$#tmp1-1]) eq join(".",@tmp2[0..$#tmp1-1]));
}
if (!defined($diffrev{$nextmain})) {
$diffrev{$nextmain} = 1;
@@ -2596,8 +2657,8 @@ sub human_readable_diff($){
print " Tag: $sym2\n" if ($sym1);
print "\n";
- my $fs = "";
- my $fe = " ";
+ my $fs = "";
+ my $fe = " ";
my $leftRow = 0;
my $rightRow = 0;
@@ -2619,6 +2680,7 @@ sub human_readable_diff($){
if ($difftxt =~ /^@@/) {
($oldline,$newline,$funname) = $difftxt =~ /@@ \-([0-9]+).*\+([0-9]+).*@@(.*)/;
+ $funname = htmlquote($funname);
print "
";
print "Line $oldline ";
print " $funname
";
@@ -2713,17 +2775,22 @@ sub human_readable_diff($){
sub navigateHeader($$$$$) {
my ($swhere,$path,$filename,$rev,$title) = @_;
$swhere = "" if ($swhere eq $scriptwhere);
- $swhere = urlencode($filename) if ($swhere eq "");
- print qq``;
- print "\n\n";
- print qq` \n`;
- print '';
- print "\n$path$filename - $title - $rev \n";
- print "$body_tag_for_src\n";
- print "";
- print "";
+ $swhere = './' . urlencode($filename) if ($swhere eq "");
+
+ print <
+
+
+
+
+$path$filename - $title - $rev
+$body_tag_for_src
+
+
+EOF
+
print &link($backicon, "$swhere$query#rev$rev");
- print " Return to ", &link("$filename","$swhere$query#rev$rev")," CVS log";
+ print "Return to ", &link($filename,"$swhere$query#rev$rev")," CVS log";
print " $fileicon ";
print "$diricon Up to ", &clickablePath($path, 1), " ";
@@ -2831,13 +2898,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 "
";
+ print "";
}
else {
# no choice ..
print "CVS Root: [$cvstree] ";
}
+
+ print " Module path or alias:\n";
+ print " \n";
+ print " ";
+
+ if (2 <= @CVSROOT) {
+ print "
";
+ }
}
sub chooseMirror() {
@@ -2940,6 +3008,8 @@ sub download_link($$$;$) {
my ($url, $revision, $textlink, $mimetype) = @_;
my ($fullurl) = download_url($url, $revision, $mimetype);
+ $fullurl =~ s/:/sprintf("%%%02x", ord($&))/eg;
+
printf 'request->header_out("Last-Modified" => scalar gmtime($moddate) . " GMT");
@@ -3066,7 +3140,7 @@ sub http_header(;$) {
print "Content-type: $content_type\r\n";
}
if ($allow_compress && $maycompress) {
- if ($has_zlib || (defined($GZIPBIN) && open(GZIP, "|$GZIPBIN -1 -c"))) {
+ if ($has_zlib || (defined($CMD{gzip}) && open(GZIP, "| $CMD{gzip} -1 -c"))) {
if ($is_mod_perl) {
Apache->request->content_encoding("x-gzip");
Apache->request->header_out(Vary => "Accept-Encoding");
@@ -3092,7 +3166,7 @@ sub http_header(;$) {
else {
print "\r\n"; # Close headers
}
- print "Unable to find gzip binary in the \$PATH to compress output ";
+ print "Unable to find gzip binary in the \$command_path ($command_path) to compress output ";
}
}
else {
@@ -3107,8 +3181,7 @@ sub http_header(;$) {
sub html_header($) {
my ($title) = @_;
- my $version = '$zRevision: 1.104 $ $kRevision: 1.47 $'; #'
- http_header(defined($charset) ? "text/html; charset=$charset" : "text/html");
+ http_header("text/html");
print <
@@ -3116,7 +3189,7 @@ sub html_header($) {
$title
-
+
$body_tag
$logo $title
@@ -3133,7 +3206,7 @@ sub link_tags($) {
my ($fileurl,$filename);
($filename = $where) =~ s/^.*\///;
- $fileurl = urlencode($filename);
+ $fileurl = './' . urlencode($filename);
foreach my $sym (split(", ", $tags)) {
$ret .= ",\n" if ($ret ne "");