===================================================================
RCS file: /cvs/cvsweb/cvsweb.cgi,v
retrieving revision 1.1.1.21
retrieving revision 1.1.1.27
diff -u -p -r1.1.1.21 -r1.1.1.27
--- cvsweb/cvsweb.cgi 2001/01/12 04:17:16 1.1.1.21
+++ cvsweb/cvsweb.cgi 2001/07/06 09:54:57 1.1.1.27
@@ -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,8 +42,8 @@
# 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.63 2001/01/11 23:42:01 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 $
#
###
@@ -52,6 +52,7 @@ require 5.000;
use strict;
use vars qw (
+ $cvsweb_revision
$mydir $uname $config $allow_version_select $verbose
@CVSrepositories @CVSROOT %CVSROOT %CVSROOTdescr
%MIRRORS %DEFAULTVALUE %ICONS %MTYPES
@@ -84,7 +85,7 @@ use vars qw (
$tabstop $state $annTable $sel $curbranch @HideModules
$module $use_descriptions %descriptions @mytz $dwhere $moddate
$use_moddate $has_zlib $gzip_open
- $allow_tar @tar_options @gzip_options @cvs_options
+ $allow_tar @tar_options @gzip_options @zip_options @cvs_options
$LOG_FILESEPARATOR $LOG_REVSEPARATOR
);
@@ -138,6 +139,10 @@ sub forbidden_module($);
##### Start of Configuration Area ########
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
@@ -165,7 +170,7 @@ $allow_version_select = 1;
# These are defined to allow checking with perl -cw
@CVSrepositories = @CVSROOT = %CVSROOT =
%MIRRORS = %DEFAULTVALUE = %ICONS = %MTYPES =
-%tags = %alltags = @tabcolors = ();
+%tags = %alltags = @tabcolors = %fileinfo = ();
$cvstreedefault = $body_tag = $body_tag_for_src =
$logo = $defaulttitle = $address =
$long_intro = $short_instruction = $shortLogLen =
@@ -248,7 +253,7 @@ $where =~ s|^/||;
$scriptname = defined($ENV{SCRIPT_NAME}) ? $ENV{SCRIPT_NAME} : '';
$scriptname =~ s|^/*|/|;
-# Let's workaround thttpd's stupidness..
+# Let's workaround thttpd's stupidity..
if ($scriptname =~ m|/$|) {
$pathinfo .= '/';
my $re = quotemeta $pathinfo;
@@ -304,9 +309,7 @@ if (-f $config) {
} 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;
@@ -515,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 '') {
@@ -527,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 $CMD{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 "$CMD{tar} @tar_options -cf - -C $tmpdir $basedir | $CMD{gzip} @gzip_options -c"
- 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 $CMD{rm}, '-rf', $tmpdir if -d $tmpdir;
- &fatal($fatal) if $fatal;
+ &fatal(@fatal) if @fatal;
exit;
}
@@ -733,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 '..') {
@@ -744,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;
@@ -810,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 = '';
@@ -904,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 " ";
}
}
@@ -1102,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);
@@ -1222,6 +1237,8 @@ sub spacedHtmlText($;$) {
sub link($$) {
my($name, $url) = @_;
+ $url =~ s/:/sprintf("%%%02x", ord($&))/eg if $url =~ /^[^a-z]/; # relative
+
sprintf '%s', hrefquote($url), $name;
}
@@ -1299,6 +1316,7 @@ sub safeglob($) {
push(@results, "$dirname/" .$_);
}
}
+ closedir($dh);
}
@results;
@@ -1312,7 +1330,7 @@ sub search_path($) {
return "$d/$command" if -x "$d/$command";
}
- $command;
+ '';
}
sub getMimeTypeFromSuffix($) {
@@ -1407,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:
@@ -1615,6 +1633,7 @@ sub doCheckout($$) {
# Parse CVS header
my ($revision, $filename, $cvsheader);
+ $filename = "";
while(<$fh>) {
last if (/^\*\*\*\*/);
$revision = $1 if (/^VERS: (.*)$/);
@@ -1698,7 +1717,11 @@ sub cvswebMarkup($$$) {
print "";
}
else {
- print "\n", <$filehandle>;
+ print "";
+ while (<$filehandle>) {
+ print htmlquote($_);
+ }
+ print " ";
}
}
@@ -1765,7 +1788,7 @@ sub doDiff($$$$$$) {
while (($re1, $re2) = each %funcline_regexp) {
if ($fullname =~ /$re1/) {
- push @difftype, '-F', '$re2';
+ push @difftype, '-F', $re2;
last;
}
}
@@ -2634,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;
@@ -2657,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 | ";
@@ -2751,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), " | ";
@@ -2979,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 '
$title
-
+
$body_tag
$logo $title
@@ -3176,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 "");
| | |