version 1.1.1.30, 2002/05/22 07:00:03 |
version 1.1.1.31, 2002/05/22 08:16:25 |
|
|
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF |
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF |
# SUCH DAMAGE. |
# SUCH DAMAGE. |
# |
# |
# $FreeBSD: projects/cvsweb/cvsweb.cgi,v 1.102 2002/05/22 06:51:59 knu Exp $ |
# $FreeBSD: projects/cvsweb/cvsweb.cgi,v 1.104 2002/05/22 08:10:18 knu Exp $ |
# $zId: cvsweb.cgi,v 1.112 2001/07/24 13:03:16 hzeller 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 $ |
# $Idaemons: /home/cvs/cvsweb/cvsweb.cgi,v 1.84 2001/10/07 20:50:10 knu Exp $ |
# |
# |
Line 104 sub htmlify($;$); |
|
Line 104 sub htmlify($;$); |
|
sub spacedHtmlText($;$); |
sub spacedHtmlText($;$); |
sub link($$); |
sub link($$); |
sub revcmp($$); |
sub revcmp($$); |
sub fatal($$); |
sub fatal($$@); |
sub redirect($); |
sub redirect($); |
sub safeglob($); |
sub safeglob($); |
sub search_path($); |
sub search_path($); |
Line 147 sub forbidden_module($); |
|
Line 147 sub forbidden_module($); |
|
##### Start of Configuration Area ######## |
##### Start of Configuration Area ######## |
delete $ENV{PATH}; |
delete $ENV{PATH}; |
|
|
$cvsweb_revision = '2.0.2'; |
$cvsweb_revision = '2.0.3'; |
|
|
use File::Basename (); |
use File::Basename (); |
|
|
|
|
@unsafevars = qw(logsort only_with_tag r1 r2 rev sortby tr1 tr2); |
@unsafevars = qw(logsort only_with_tag r1 r2 rev sortby tr1 tr2); |
|
|
if (-f $config) { |
if (-f $config) { |
do "$config" or &fatal( |
do "$config" or fatal("500 Internal Error", |
"500 Internal Error", |
'Error in loading configuration file: %s<br><br>%s<br>', |
sprintf( |
$config, $@); |
'Error in loading configuration file: %s<br><br>%s<br>', |
|
$config, |
|
&htmlify($@) |
|
) |
|
); |
|
} else { |
} else { |
&fatal("500 Internal Error", |
fatal("500 Internal Error", |
'Configuration not found. Set the variable <code>$config</code> ' |
'Configuration not found. Set the variable <code>$config</code> in cvsweb.cgi to your <b>cvsweb.conf</b> configuration file first.' |
. 'in cvsweb.cgi to your <b>cvsweb.conf</b> configuration file first.' |
); |
); |
|
} |
} |
|
|
undef %input; |
undef %input; |
Line 341 $input{only_with_tag} = $input{only_on_branch} |
|
Line 335 $input{only_with_tag} = $input{only_on_branch} |
|
|
|
# Prevent cross-site scripting |
# Prevent cross-site scripting |
foreach (@unsafevars) { |
foreach (@unsafevars) { |
if (defined($input{$_}) && $input{$_} =~ /[^\w\-.]/) { |
if (defined($input{$_}) && $input{$_} =~ /[^\w\-.]/) { |
fatal("500 Internal Error", "Malformed query string ($_)"); |
fatal("500 Internal Error", |
} |
'Malformed query (%s=%s)', |
|
$_, $input{$_}); |
|
} |
} |
} |
|
|
if (defined($input{"content-type"})) { |
if (defined($input{"content-type"})) { |
Line 447 $logsort = $input{'logsort'}; |
|
Line 443 $logsort = $input{'logsort'}; |
|
|
|
## Default CVS-Tree |
## Default CVS-Tree |
if (!defined($CVSROOT{$cvstreedefault})) { |
if (!defined($CVSROOT{$cvstreedefault})) { |
&fatal("500 Internal Error", |
fatal("500 Internal Error", |
"<code>\$cvstreedefault</code> points to a repository ($cvstreedefault) " |
'<code>$cvstreedefault</code> points to a repository (%s) not defined in <code>%%CVSROOT</code> (edit your configuration file %s)', |
. "not defined in <code>%CVSROOT</code> " |
$cvstreedefault, $config); |
. "(edit your configuration file $config)"); |
|
} |
} |
|
|
# alternate CVS-Tree, configured in cvsweb.conf |
# alternate CVS-Tree, configured in cvsweb.conf |
Line 482 my $config_cvstree = "$config-$cvstree"; |
|
Line 477 my $config_cvstree = "$config-$cvstree"; |
|
|
|
# Do some special configuration for cvstrees |
# Do some special configuration for cvstrees |
if (-f $config_cvstree) { |
if (-f $config_cvstree) { |
do "$config_cvstree" or &fatal( |
do "$config_cvstree" or |
"500 Internal Error", |
fatal("500 Internal Error", |
sprintf( |
'Error in loading configuration file: %s<br><br>%s<br>', |
'Error in loading configuration file: %s<br><br>%s<br>', |
$config_cvstree, $@); |
$config_cvstree, |
|
&htmlify($@) |
|
) |
|
); |
|
} |
} |
undef $config_cvstree; |
undef $config_cvstree; |
|
|
|
|
undef $rewrite; |
undef $rewrite; |
|
|
if (!-d $cvsroot) { |
if (!-d $cvsroot) { |
&fatal("500 Internal Error", |
fatal("500 Internal Error", |
'$CVSROOT not found!<p>The server on which the CVS tree lives is probably down. Please try again in a few minutes.' |
'$CVSROOT not found!<p>The server on which the CVS tree lives is probably down. Please try again in a few minutes.'); |
); |
|
} |
} |
|
|
# |
# |
Line 537 if (!-d $cvsroot) { |
|
Line 527 if (!-d $cvsroot) { |
|
$where =~ m:([^/]*):; |
$where =~ m:([^/]*):; |
$module = $1; |
$module = $1; |
if ($module && &forbidden_module($module)) { |
if ($module && &forbidden_module($module)) { |
&fatal("403 Forbidden", "Access to $where forbidden."); |
fatal("403 Forbidden", |
|
'Access to %s forbidden.', |
|
$where); |
} |
} |
|
|
# |
# |
# Handle tarball downloads before any headers are output. |
# Handle tarball downloads before any headers are output. |
# |
# |
if ($input{tarball}) { |
if ($input{tarball}) { |
&fatal("403 Forbidden", "Downloading tarballs is prohibited.") |
fatal("403 Forbidden", |
|
'Downloading tarballs is prohibited.') |
unless $allow_tar; |
unless $allow_tar; |
my ($module) = ($where =~ m,^/?(.*),); # untaint |
my ($module) = ($where =~ m,^/?(.*),); # untaint |
$module =~ s,/([^/]*)$,,; |
$module =~ s,/([^/]*)$,,; |
Line 552 if ($input{tarball}) { |
|
Line 545 if ($input{tarball}) { |
|
my ($basedir) = ($module =~ m,([^/]+)$,); |
my ($basedir) = ($module =~ m,([^/]+)$,); |
|
|
if ($basedir eq '' || $module eq '') { |
if ($basedir eq '' || $module eq '') { |
&fatal("500 Internal Error", |
fatal("500 Internal Error", |
"You cannot download the top level directory."); |
'You cannot download the top level directory.'); |
} |
} |
|
|
my $tmpexportdir = "$tmpdir/.cvsweb.$$." . int(time); |
my $tmpexportdir = "$tmpdir/.cvsweb.$$." . int(time); |
|
|
mkdir($tmpexportdir, 0700) |
mkdir($tmpexportdir, 0700) |
or &fatal("500 Internal Error", |
or fatal("500 Internal Error", |
"Unable to make temporary directory: $!"); |
'Unable to make temporary directory: %s', |
|
$!); |
|
|
my @fatal; |
my @fatal; |
|
|
Line 575 if ($input{tarball}) { |
|
Line 569 if ($input{tarball}) { |
|
if (system $CMD{cvs}, @cvs_options, '-Qd', $cvsroot, 'export', '-r', |
if (system $CMD{cvs}, @cvs_options, '-Qd', $cvsroot, 'export', '-r', |
$tag, '-d', "$tmpexportdir/$basedir", $module) |
$tag, '-d', "$tmpexportdir/$basedir", $module) |
{ |
{ |
@fatal = ("500 Internal Error", "cvs co failure: $!: $module"); |
@fatal = ("500 Internal Error", |
|
'cvs co failure: %s: %s', |
|
$!, $module); |
} else { |
} else { |
$| = 1; # Essential to get the buffering right. |
$| = 1; # Essential to get the buffering right. |
|
|
Line 585 if ($input{tarball}) { |
|
Line 581 if ($input{tarball}) { |
|
system |
system |
"$CMD{tar} @tar_options -cf - -C $tmpexportdir $basedir | $CMD{gzip} @gzip_options -c" |
"$CMD{tar} @tar_options -cf - -C $tmpexportdir $basedir | $CMD{gzip} @gzip_options -c" |
and @fatal = |
and @fatal = |
("500 Internal Error", |
("500 Internal Error", |
"tar zc failure: $!: $basedir"); |
'tar zc failure: %s: %s', |
|
$!, $basedir); |
} elsif ($ext eq '.zip' && $CMD{zip}) { |
} elsif ($ext eq '.zip' && $CMD{zip}) { |
print "Content-Type: application/zip\r\n\r\n"; |
print "Content-Type: application/zip\r\n\r\n"; |
|
|
system |
system |
"cd $tmpexportdir && $CMD{zip} @zip_options -r - $basedir" |
"cd $tmpexportdir && $CMD{zip} @zip_options -r - $basedir" |
and @fatal = |
and @fatal = |
("500 Internal Error", "zip failure: $!: $basedir"); |
("500 Internal Error", |
|
'zip failure: %s: %s', |
|
$!, $basedir); |
} else { |
} else { |
@fatal = |
@fatal = |
("500 Internal Error", "unsupported file type"); |
("500 Internal Error", |
|
'unsupported file type'); |
} |
} |
} |
} |
|
|
Line 612 if ($input{tarball}) { |
|
Line 612 if ($input{tarball}) { |
|
############################### |
############################### |
if (-d $fullname) { |
if (-d $fullname) { |
my $dh = do { local (*DH); }; |
my $dh = do { local (*DH); }; |
opendir($dh, $fullname) or &fatal("404 Not Found", "$where: $!"); |
opendir($dh, $fullname) or fatal("404 Not Found", |
|
'%s: %s', |
|
$where, $!); |
my @dir = readdir($dh); |
my @dir = readdir($dh); |
closedir($dh); |
closedir($dh); |
my @subLevelFiles = findLastModifiedSubdirs(@dir) |
my @subLevelFiles = findLastModifiedSubdirs(@dir) |
Line 1169 elsif (-f $fullname . ',v') { |
|
Line 1171 elsif (-f $fullname . ',v') { |
|
} |
} |
} |
} |
} |
} |
&fatal("404 Not Found", "$where: no such file or directory"); |
fatal("404 Not Found", |
|
'%s: no such file or directory', |
|
$where); |
} |
} |
|
|
gzipclose(); |
gzipclose(); |
Line 1403 sub revcmp($$) { |
|
Line 1407 sub revcmp($$) { |
|
return 0; |
return 0; |
} |
} |
|
|
sub fatal($$) { |
sub fatal($$@) { |
my ($errcode, $errmsg) = @_; |
my ($errcode, $format, @args) = @_; |
if ($is_mod_perl) { |
if ($is_mod_perl) { |
Apache->request->status((split (/ /, $errcode))[0]); |
Apache->request->status((split (/ /, $errcode))[0]); |
} else { |
} else { |
print "Status: $errcode\r\n"; |
print "Status: $errcode\r\n"; |
} |
} |
html_header("Error"); |
html_header("Error"); |
print "<p>Error: ", htmlquote($errmsg), "</p>\n"; |
print "<p>Error: ", |
|
sprintf($format, map(htmlquote($_), @args)), |
|
"</p>\n"; |
html_footer(); |
html_footer(); |
exit(1); |
exit(1); |
} |
} |
Line 1561 sub doAnnotate($$) { |
|
Line 1567 sub doAnnotate($$) { |
|
# make sure the revisions are wellformed, for security |
# make sure the revisions are wellformed, for security |
# reasons .. |
# reasons .. |
if ($rev =~ /[^\w.]/) { |
if ($rev =~ /[^\w.]/) { |
&fatal("404 Not Found", |
fatal("404 Not Found", |
"Malformed query \"$ENV{QUERY_STRING}\""); |
'Malformed query "%s"', |
|
$ENV{QUERY_STRING}); |
} |
} |
|
|
if (&forbidden_file($fullname)) { |
if (&forbidden_file($fullname)) { |
&fatal("403 Forbidden", |
fatal("403 Forbidden", |
"Access forbidden. This file is mentioned in \@ForbiddenFiles" |
'Access forbidden. This file is mentioned in @ForbiddenFiles'); |
); |
|
return; |
return; |
} |
} |
|
|
Line 1587 sub doAnnotate($$) { |
|
Line 1593 sub doAnnotate($$) { |
|
# the cvsserver in a similiar way one day (..after rewrite) |
# the cvsserver in a similiar way one day (..after rewrite) |
$pid = open2($reader, $writer, $CMD{cvs}, @cvs_options, "server") |
$pid = open2($reader, $writer, $CMD{cvs}, @cvs_options, "server") |
or fatal("500 Internal Error", |
or fatal("500 Internal Error", |
"Fatal Error - unable to open cvs for annotation"); |
'Fatal Error - unable to open cvs for annotation'); |
|
|
# OK, first send the request to the server. A simplified example is: |
# OK, first send the request to the server. A simplified example is: |
# Root /home/kingdon/zwork/cvsroot |
# Root /home/kingdon/zwork/cvsroot |
Line 1722 sub doAnnotate($$) { |
|
Line 1728 sub doAnnotate($$) { |
|
# CVS command line client. But for simplicity, we don't. |
# CVS command line client. But for simplicity, we don't. |
} elsif ($words[0] eq "error") { |
} elsif ($words[0] eq "error") { |
fatal("500 Internal Error", |
fatal("500 Internal Error", |
"Error occured during annotate: <b>$_</b>"); |
'Error occured during annotate: <b>%s</b>', |
|
$_); |
} |
} |
} |
} |
|
|
Line 1750 sub doCheckout($$) { |
|
Line 1757 sub doCheckout($$) { |
|
# make sure the revisions a wellformed, for security |
# make sure the revisions a wellformed, for security |
# reasons .. |
# reasons .. |
if (defined($rev) && $rev =~ /[^\w.]/) { |
if (defined($rev) && $rev =~ /[^\w.]/) { |
&fatal("404 Not Found", |
fatal("404 Not Found", |
"Malformed query \"$ENV{QUERY_STRING}\""); |
'Malformed query "%s"', |
|
$ENV{QUERY_STRING}); |
} |
} |
|
|
if (&forbidden_file($fullname)) { |
if (&forbidden_file($fullname)) { |
&fatal("403 Forbidden", |
fatal("403 Forbidden", |
"Access forbidden. This file is mentioned in \@ForbiddenFiles" |
'Access forbidden. This file is mentioned in @ForbiddenFiles'); |
); |
|
return; |
return; |
} |
} |
|
|
Line 1805 sub doCheckout($$) { |
|
Line 1812 sub doCheckout($$) { |
|
} |
} |
|
|
if (eof($fh)) { |
if (eof($fh)) { |
&fatal("404 Not Found", "$where is not (any longer) pertinent"); |
fatal("404 Not Found", |
|
'%s is not (any longer) pertinent', |
|
$where); |
} |
} |
|
|
#=================================================================== |
#=================================================================== |
Line 1829 sub doCheckout($$) { |
|
Line 1838 sub doCheckout($$) { |
|
} |
} |
|
|
if ($filename ne $where) { |
if ($filename ne $where) { |
&fatal("500 Internal Error", |
fatal("500 Internal Error", |
"Unexpected output from cvs co: $cvsheader"); |
'Unexpected output from cvs co: %s', |
|
$cvsheader); |
} |
} |
$| = 1; |
$| = 1; |
|
|
Line 1924 sub doDiff($$$$$$) { |
|
Line 1934 sub doDiff($$$$$$) { |
|
my ($rev1, $rev2, $sym1, $sym2, $f1, $f2); |
my ($rev1, $rev2, $sym1, $sym2, $f1, $f2); |
|
|
if (&forbidden_file($fullname)) { |
if (&forbidden_file($fullname)) { |
&fatal("403 Forbidden", |
fatal("403 Forbidden", |
"Access forbidden. This file is mentioned in \@ForbiddenFiles" |
'Access forbidden. This file is mentioned in @ForbiddenFiles'); |
); |
|
return; |
return; |
} |
} |
|
|
Line 1951 sub doDiff($$$$$$) { |
|
Line 1960 sub doDiff($$$$$$) { |
|
# make sure the revisions a wellformed, for security |
# make sure the revisions a wellformed, for security |
# reasons .. |
# reasons .. |
if ($rev1 =~ /[^\w.]/ || $rev2 =~ /[^\w.]/) { |
if ($rev1 =~ /[^\w.]/ || $rev2 =~ /[^\w.]/) { |
&fatal("404 Not Found", |
fatal("404 Not Found", |
"Malformed query \"$ENV{QUERY_STRING}\""); |
'Malformed query "%s"', |
|
$ENV{QUERY_STRING}); |
} |
} |
|
|
# |
# |
Line 1967 sub doDiff($$$$$$) { |
|
Line 1977 sub doDiff($$$$$$) { |
|
my $difftype = $DIFFTYPES{$f}; |
my $difftype = $DIFFTYPES{$f}; |
|
|
if (!$difftype) { |
if (!$difftype) { |
fatal("400 Bad arguments", "Diff format $f not understood"); |
fatal("400 Bad arguments", |
|
'Diff format %s not understood', |
|
$f); |
} |
} |
|
|
my @difftype = @{$difftype->{'opts'}}; |
my @difftype = @{$difftype->{'opts'}}; |
Line 2261 sub getDirLogs($$@) { |
|
Line 2273 sub getDirLogs($$@) { |
|
} |
} |
|
|
if ($. == 0) { |
if ($. == 0) { |
fatal("500 Internal Error", "Failed to spawn GNU rlog on <em>'" |
fatal("500 Internal Error", |
. join (", ", @files) |
'Failed to spawn GNU rlog on <em>"%s"</em>. <p>Did you set the <b>$command_path</b> in your configuration file correctly ? (Currently "%s"', |
. "'</em><p>Did you set the <b>\$command_path</b> in your configuration file correctly ? (Currently '$command_path'" |
join (", ", @files), $command_path); |
); |
|
} |
} |
close($fh); |
close($fh); |
} |
} |
Line 2352 sub readLog($;$) { |
|
Line 2363 sub readLog($;$) { |
|
# these lines since we don't know what revision they go with |
# these lines since we don't know what revision they go with |
# any more. |
# any more. |
next logentry; |
next logentry; |
|
|
# &fatal("500 Internal Error","Error parsing RCS output: $_"); |
|
} |
} |
$_ = <$fh>; |
$_ = <$fh>; |
print "D:", $_ if ($verbose); |
print "D:", $_ if ($verbose); |
Line 2373 sub readLog($;$) { |
|
Line 2382 sub readLog($;$) { |
|
$state{$rev} = $8; |
$state{$rev} = $8; |
$difflines{$rev} = $10; |
$difflines{$rev} = $10; |
} else { |
} else { |
&fatal("500 Internal Error", |
fatal("500 Internal Error", |
"Error parsing RCS output: $_"); |
'Error parsing RCS output: %s', |
|
$_); |
} |
} |
line: |
line: |
|
|
Line 2481 sub readLog($;$) { |
|
Line 2491 sub readLog($;$) { |
|
|
|
if (!defined($onlyonbranch) || $onlybranchpoint eq "") { |
if (!defined($onlyonbranch) || $onlybranchpoint eq "") { |
fatal("404 Tag not found", |
fatal("404 Tag not found", |
"Tag $input{'only_with_tag'} not defined"); |
'Tag %s not defined', |
|
$input{'only_with_tag'}); |
} |
} |
} |
} |
|
|