The server on which the CVS tree lives is probably down. Please try again in a few minutes.');
}
@@ -508,7 +518,8 @@ if ($input{tarball}) {
&fatal("403 Forbidden", "Downloading tarballs is prohibited.")
unless $allow_tar;
my($module) = ($where =~ m,^/?(.*),); # untaint
- $module =~ s,/[^/]*$,,;
+ $module =~ s,/([^/]*)$,,;
+ my($ext) = ($1 =~ /(\.tar\.gz|\.zip)$/);
my($basedir) = ($module =~ m,([^/]+)$,);
if ($basedir eq '' || $module eq '') {
@@ -520,30 +531,34 @@ if ($input{tarball}) {
mkdir($tmpdir, 0700)
or &fatal("500 Internal Error", "Unable to make temporary directory: $!");
- my $fatal = '';
+ my @fatal;
- while (1) {
- my $tag = (exists $input{only_with_tag} && length $input{only_with_tag})
- ? $input{only_with_tag} : "HEAD";
+ my $tag = (exists $input{only_with_tag} && length $input{only_with_tag})
+ ? $input{only_with_tag} : "HEAD";
- system "cvs", @cvs_options, "-Qd", $cvsroot, "export", "-r", $tag, "-d", "$tmpdir/$basedir", $module
- and $fatal = "500 Internal Error","cvs co failure: $!: $module"
- && 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", @tar_options, "-zcf", "-", "-C", $tmpdir, $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";
- last;
+ 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;
}
@@ -726,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 '..') {
@@ -737,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;
@@ -803,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 = '';
@@ -897,13 +913,19 @@ if (-d $fullname) {
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 " ";
}
}
@@ -1006,7 +1028,7 @@ 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) {
@@ -1095,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);
@@ -1213,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($$) {
@@ -1292,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);
@@ -1370,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",
@@ -1389,7 +1425,7 @@ 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", @cvs_options, "server")
+ $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:
@@ -1581,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", @cvs_options, "-d", $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)) {
@@ -1597,6 +1633,7 @@ sub doCheckout($$) {
# Parse CVS header
my ($revision, $filename, $cvsheader);
+ $filename = "";
while(<$fh>) {
last if (/^\*\*\*\*/);
$revision = $1 if (/^VERS: (.*)$/);
@@ -1680,7 +1717,11 @@ sub cvswebMarkup($$$) {
print "";
}
else {
- print "<![CDATA[\n", <$filehandle>;
+ print "<PRE>";
+ while (<$filehandle>) {
+ print htmlquote($_);
+ }
+ print "</PRE>";
}
}
@@ -1747,7 +1788,7 @@ sub doDiff($$$$$$) {
while (($re1, $re2) = each %funcline_regexp) {
if ($fullname =~ /$re1/) {
- push @difftype, '-F', '$re2';
+ push @difftype, '-F', $re2;
last;
}
}
@@ -1762,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();
@@ -1846,15 +1887,14 @@ sub getDirLogs($$@) {
if (defined($tag)) {
#can't use -r<tag> 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";
@@ -1984,7 +2024,7 @@ again:
}
if ($. == 0) {
fatal("500 Internal Error",
- "Failed to spawn GNU rlog on <em>'".join(", ", @files)."'</em><p>did you set the <b>\$ENV{PATH}</b> in your configuration file correctly ?");
+ "Failed to spawn GNU rlog on <em>'".join(", ", @files)."'</em><p>Did you set the <b>\$command_path</b> in your configuration file correctly ? (Currently '$command_path'");
}
close($fh);
}
@@ -2012,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);
@@ -2617,8 +2657,8 @@ sub human_readable_diff($){
print "<br>Tag: $sym2\n" if ($sym1);
print "</th>\n";
- my $fs = "<font face=\"$difffontface\" size=\"$difffontsize\">";
- my $fe = "</font>";
+ my $fs = "<font face=\"$difffontface\" size=\"$difffontsize\"><tt>";
+ my $fe = "</tt></font>";
my $leftRow = 0;
my $rightRow = 0;
@@ -2640,6 +2680,7 @@ sub human_readable_diff($){
if ($difftxt =~ /^@@/) {
($oldline,$newline,$funname) = $difftxt =~ /@@ \-([0-9]+).*\+([0-9]+).*@@(.*)/;
+ $funname = htmlquote($funname);
print "<tr bgcolor=\"$diffcolorHeading\"><td width=\"50%\">";
print "<table width=\"100%\" border=1 cellpadding=5><tr><td><b>Line $oldline</b>";
print " <font size=-1>$funname</font></td></tr></table>";
@@ -2734,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`<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">`;
- print "<HTML>\n<HEAD>\n";
- print qq`<META name="robots" content="nofollow">\n`;
- print '<!-- CVSweb $zRevision: 1.104 $ $kRevision: 1.57 $ -->';
- print "\n<TITLE>$path$filename - $title - $rev</TITLE></HEAD>\n";
- print "$body_tag_for_src\n";
- print "<table width=\"100%\" border=0 cellspacing=0 cellpadding=1 bgcolor=\"$navigationHeaderColor\">";
- print "<tr valign=bottom><td>";
+ $swhere = './' . urlencode($filename) if ($swhere eq "");
+
+ print <<EOF;
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
+<HTML>
+<HEAD>
+<META name="robots" content="nofollow">
+<!-- knu-cvsweb $cvsweb_revision -->
+<TITLE>$path$filename - $title - $rev</TITLE></HEAD>
+$body_tag_for_src
+<table width="100%" border=0 cellspacing=0 cellpadding=1 bgcolor="$navigationHeaderColor">
+<tr valign=bottom><td>
+EOF
+
print &link($backicon, "$swhere$query#rev$rev");
- print "</a> <b>Return to ", &link("$filename","$swhere$query#rev$rev")," CVS log";
+ print "<b>Return to ", &link($filename,"$swhere$query#rev$rev")," CVS log";
print "</b> $fileicon</td>";
print "<td align=right>$diricon <b>Up to ", &clickablePath($path, 1), "</b></td>";
@@ -2962,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 '<A HREF="%s"', hrefquote("$fullurl$barequery");
if ($open_extern_window && (!defined($mimetype) || $mimetype ne "text/x-cvsweb-markup")) {
@@ -3092,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");
@@ -3118,7 +3166,7 @@ sub http_header(;$) {
else {
print "\r\n"; # Close headers
}
- print "<font size=-1>Unable to find gzip binary in the \$PATH to compress output</font><br>";
+ print "<font size=-1>Unable to find gzip binary in the <b>\$command_path</b> ($command_path) to compress output</font><br>";
}
}
else {
@@ -3133,7 +3181,6 @@ sub http_header(;$) {
sub html_header($) {
my ($title) = @_;
- my $version = '$zRevision: 1.104 $ $kRevision: 1.57 $'; #'
http_header("text/html");
print <<EOH;
<!doctype html public "-//W3C//DTD HTML 4.0 Transitional//EN"
@@ -3142,7 +3189,7 @@ sub html_header($) {
<head>
<meta name="robots" content="nofollow">
<title>$title</title>
-<!-- CVSweb $version -->
+<!-- knu-cvsweb $cvsweb_revision -->
</head>
$body_tag
$logo <h1 align="center">$title</h1>
@@ -3159,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 "");
]]></plaintext></td></tr></div> |