version 1.1.1.21, 2001/01/12 04:17:16 |
version 1.1.1.27, 2001/07/06 09:54:57 |
|
|
# Copyright (c) 1996-1998 Bill Fenner |
# Copyright (c) 1996-1998 Bill Fenner |
# (c) 1998-1999 Henner Zeller |
# (c) 1998-1999 Henner Zeller |
# (c) 1999 Henrik Nordstrom |
# (c) 1999 Henrik Nordstrom |
# (c) 2000 Akinori MUSHA |
# (c) 2000-2001 Akinori MUSHA |
# All rights reserved. |
# All rights reserved. |
# |
# |
# Redistribution and use in source and binary forms, with or without |
# Redistribution and use in source and binary forms, with or without |
|
|
# 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. |
# |
# |
# $zId: cvsweb.cgi,v 1.104 2000/11/01 22:05:12 hnordstrom Exp $ |
# $zId: cvsweb.cgi,v 1.110 2001/06/29 09:29:36 hnordstrom Exp $ |
# $kId: cvsweb.cgi,v 1.63 2001/01/11 23:42:01 knu Exp $ |
# $Idaemons: /home/cvs/cvsweb/cvsweb.cgi,v 1.78 2001/07/06 09:49:01 knu Exp $ |
# |
# |
### |
### |
|
|
|
|
use strict; |
use strict; |
|
|
use vars qw ( |
use vars qw ( |
|
$cvsweb_revision |
$mydir $uname $config $allow_version_select $verbose |
$mydir $uname $config $allow_version_select $verbose |
@CVSrepositories @CVSROOT %CVSROOT %CVSROOTdescr |
@CVSrepositories @CVSROOT %CVSROOT %CVSROOTdescr |
%MIRRORS %DEFAULTVALUE %ICONS %MTYPES |
%MIRRORS %DEFAULTVALUE %ICONS %MTYPES |
|
|
$tabstop $state $annTable $sel $curbranch @HideModules |
$tabstop $state $annTable $sel $curbranch @HideModules |
$module $use_descriptions %descriptions @mytz $dwhere $moddate |
$module $use_descriptions %descriptions @mytz $dwhere $moddate |
$use_moddate $has_zlib $gzip_open |
$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 |
$LOG_FILESEPARATOR $LOG_REVSEPARATOR |
); |
); |
|
|
Line 138 sub forbidden_module($); |
|
Line 139 sub forbidden_module($); |
|
##### Start of Configuration Area ######## |
##### Start of Configuration Area ######## |
delete $ENV{PATH}; |
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; |
use File::Basename; |
|
|
($mydir) = (dirname($0) =~ /(.*)/); # untaint |
($mydir) = (dirname($0) =~ /(.*)/); # untaint |
Line 165 $allow_version_select = 1; |
|
Line 170 $allow_version_select = 1; |
|
# These are defined to allow checking with perl -cw |
# These are defined to allow checking with perl -cw |
@CVSrepositories = @CVSROOT = %CVSROOT = |
@CVSrepositories = @CVSROOT = %CVSROOT = |
%MIRRORS = %DEFAULTVALUE = %ICONS = %MTYPES = |
%MIRRORS = %DEFAULTVALUE = %ICONS = %MTYPES = |
%tags = %alltags = @tabcolors = (); |
%tags = %alltags = @tabcolors = %fileinfo = (); |
$cvstreedefault = $body_tag = $body_tag_for_src = |
$cvstreedefault = $body_tag = $body_tag_for_src = |
$logo = $defaulttitle = $address = |
$logo = $defaulttitle = $address = |
$long_intro = $short_instruction = $shortLogLen = |
$long_intro = $short_instruction = $shortLogLen = |
Line 248 $where =~ s|^/||; |
|
Line 253 $where =~ s|^/||; |
|
$scriptname = defined($ENV{SCRIPT_NAME}) ? $ENV{SCRIPT_NAME} : ''; |
$scriptname = defined($ENV{SCRIPT_NAME}) ? $ENV{SCRIPT_NAME} : ''; |
$scriptname =~ s|^/*|/|; |
$scriptname =~ s|^/*|/|; |
|
|
# Let's workaround thttpd's stupidness.. |
# Let's workaround thttpd's stupidity.. |
if ($scriptname =~ m|/$|) { |
if ($scriptname =~ m|/$|) { |
$pathinfo .= '/'; |
$pathinfo .= '/'; |
my $re = quotemeta $pathinfo; |
my $re = quotemeta $pathinfo; |
Line 304 if (-f $config) { |
|
Line 309 if (-f $config) { |
|
} 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, or the environment variable ' |
. 'in cvsweb.cgi to your <b>cvsweb.conf</b> configuration file first.'); |
. '<code>CVSWEB_CONFIG</code>, to your <b>cvsweb.conf</b> ' |
|
. 'configuration file first.'); |
|
} |
} |
|
|
undef %input; |
undef %input; |
Line 515 if ($input{tarball}) { |
|
Line 518 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,/([^/]*)$,,; |
|
my($ext) = ($1 =~ /(\.tar\.gz|\.zip)$/); |
my($basedir) = ($module =~ m,([^/]+)$,); |
my($basedir) = ($module =~ m,([^/]+)$,); |
|
|
if ($basedir eq '' || $module eq '') { |
if ($basedir eq '' || $module eq '') { |
Line 527 if ($input{tarball}) { |
|
Line 531 if ($input{tarball}) { |
|
mkdir($tmpdir, 0700) |
mkdir($tmpdir, 0700) |
or &fatal("500 Internal Error", "Unable to make temporary directory: $!"); |
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}) |
my $tag = (exists $input{only_with_tag} && length $input{only_with_tag}) |
? $input{only_with_tag} : "HEAD"; |
? $input{only_with_tag} : "HEAD"; |
|
|
|
system $CMD{cvs}, @cvs_options, '-Qd', $cvsroot, 'export', '-r', $tag, '-d', "$tmpdir/$basedir", $module |
if (system $CMD{cvs}, @cvs_options, '-Qd', $cvsroot, 'export', '-r', $tag, '-d', "$tmpdir/$basedir", $module) { |
and $fatal = "500 Internal Error","cvs co failure: $!: $module" |
@fatal = ("500 Internal Error", "cvs co failure: $!: $module"); |
&& last; |
} else { |
|
|
$| = 1; # Essential to get the buffering right. |
$| = 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" |
system "$CMD{tar} @tar_options -cf - -C $tmpdir $basedir | $CMD{gzip} @gzip_options -c" |
and $fatal = "500 Internal Error","tar zc failure: $!: $basedir" |
and @fatal = ("500 Internal Error", "tar zc failure: $!: $basedir"); |
&& last; |
} 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; |
system $CMD{rm}, '-rf', $tmpdir if -d $tmpdir; |
|
|
&fatal($fatal) if $fatal; |
&fatal(@fatal) if @fatal; |
|
|
exit; |
exit; |
} |
} |
Line 733 if (-d $fullname) { |
|
Line 741 if (-d $fullname) { |
|
|
|
if ($_ eq '..' || -d "$fullname/$_") { |
if ($_ eq '..' || -d "$fullname/$_") { |
next if ($_ eq '..' && $where eq '/'); |
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{$_})); |
if (defined($fileinfo{$_})); |
printf '<tr bgcolor="%s"><td>', $tabcolors[$dirrow % 2] if $dirtable; |
printf '<tr bgcolor="%s"><td>', $tabcolors[$dirrow % 2] if $dirtable; |
if ($_ eq '..') { |
if ($_ eq '..') { |
Line 744 if (-d $fullname) { |
|
Line 753 if (-d $fullname) { |
|
else { |
else { |
print &link($backicon, $url); |
print &link($backicon, $url); |
} |
} |
print " ", &link("Previous Directory", $url); |
print " ", &link("Parent Directory", $url); |
} |
} |
else { |
else { |
$url = urlencode($_) . "/$query"; |
$url = './' . urlencode($_) . "/$query"; |
print "<A NAME=\"$_\"></A>"; |
print "<A NAME=\"$_\"></A>"; |
if ($nofilelinks) { |
if ($nofilelinks) { |
print $diricon; |
print $diricon; |
Line 810 if (-d $fullname) { |
|
Line 819 if (-d $fullname) { |
|
} |
} |
elsif (s/,v$//) { |
elsif (s/,v$//) { |
$fileurl = ($attic ? "Attic/" : "") . urlencode($_); |
$fileurl = ($attic ? "Attic/" : "") . urlencode($_); |
$url = $fileurl . $query; |
$url = './' . $fileurl . $query; |
my $rev = ''; |
my $rev = ''; |
my $date = ''; |
my $date = ''; |
my $log = ''; |
my $log = ''; |
Line 904 if (-d $fullname) { |
|
Line 913 if (-d $fullname) { |
|
|
|
if (defined($basefile) && $basefile ne '') { |
if (defined($basefile) && $basefile ne '') { |
print "<HR NOSHADE>\n", |
print "<HR NOSHADE>\n", |
"<DIV align=center>", |
"<DIV align=center>Download this directory in "; |
&link("Download this directory in tarball", |
# Mangle the filename so browsers show a reasonable |
# Mangle the filename so browsers show a reasonable |
# filename to download. |
# filename to download. |
print &link("tarball", |
"$basefile.tar.gz$query". |
"./$basefile.tar.gz$query". |
($query ? "&" : "?")."tarball=1"), |
($query ? "&" : "?")."tarball=1"); |
"</DIV>"; |
if ($CMD{zip}) { |
|
print " or ", |
|
&link("zip archive", |
|
"./$basefile.zip$query". |
|
($query ? "&" : "?")."tarball=1"); |
|
} |
|
print "</DIV>"; |
} |
} |
} |
} |
|
|
Line 1102 sub findLastModifiedSubdirs(@) { |
|
Line 1117 sub findLastModifiedSubdirs(@) { |
|
|
|
sub htmlify_sub(&$) { |
sub htmlify_sub(&$) { |
(my $proc, local $_) = @_; |
(my $proc, local $_) = @_; |
local @_ = split(m`(<a [^>]+>[^<]*</a>)`i); |
my @a = split(m`(<a [^>]+>[^<]*</a>)`i); |
my $linked; |
my $linked; |
my $result = ''; |
my $result = ''; |
|
|
while (($_, $linked) = splice(@_, 0, 2)) { |
while (($_, $linked) = splice(@a, 0, 2)) { |
&$proc(); |
&$proc(); |
$result .= $_ if defined($_); |
$result .= $_ if defined($_); |
$result .= $linked if defined($linked); |
$result .= $linked if defined($linked); |
Line 1222 sub spacedHtmlText($;$) { |
|
Line 1237 sub spacedHtmlText($;$) { |
|
sub link($$) { |
sub link($$) { |
my($name, $url) = @_; |
my($name, $url) = @_; |
|
|
|
$url =~ s/:/sprintf("%%%02x", ord($&))/eg if $url =~ /^[^a-z]/; # relative |
|
|
sprintf '<A HREF="%s">%s</A>', hrefquote($url), $name; |
sprintf '<A HREF="%s">%s</A>', hrefquote($url), $name; |
} |
} |
|
|
Line 1299 sub safeglob($) { |
|
Line 1316 sub safeglob($) { |
|
push(@results, "$dirname/" .$_); |
push(@results, "$dirname/" .$_); |
} |
} |
} |
} |
|
closedir($dh); |
} |
} |
|
|
@results; |
@results; |
Line 1312 sub search_path($) { |
|
Line 1330 sub search_path($) { |
|
return "$d/$command" if -x "$d/$command"; |
return "$d/$command" if -x "$d/$command"; |
} |
} |
|
|
$command; |
''; |
} |
} |
|
|
sub getMimeTypeFromSuffix($) { |
sub getMimeTypeFromSuffix($) { |
Line 1407 sub doAnnotate($$) { |
|
Line 1425 sub doAnnotate($$) { |
|
# the public domain. |
# the public domain. |
# we could abandon the use of rlog, rcsdiff and co using |
# we could abandon the use of rlog, rcsdiff and co using |
# the cvsserver in a similiar way one day (..after rewrite) |
# 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"); |
|| fatal ("500 Internal Error", "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: |
Line 1615 sub doCheckout($$) { |
|
Line 1633 sub doCheckout($$) { |
|
|
|
# Parse CVS header |
# Parse CVS header |
my ($revision, $filename, $cvsheader); |
my ($revision, $filename, $cvsheader); |
|
$filename = ""; |
while(<$fh>) { |
while(<$fh>) { |
last if (/^\*\*\*\*/); |
last if (/^\*\*\*\*/); |
$revision = $1 if (/^VERS: (.*)$/); |
$revision = $1 if (/^VERS: (.*)$/); |
Line 1698 sub cvswebMarkup($$$) { |
|
Line 1717 sub cvswebMarkup($$$) { |
|
print "</PRE>"; |
print "</PRE>"; |
} |
} |
else { |
else { |
print "<PLAINTEXT>\n", <$filehandle>; |
print "<PRE>"; |
|
while (<$filehandle>) { |
|
print htmlquote($_); |
|
} |
|
print "</PRE>"; |
} |
} |
} |
} |
|
|
Line 1765 sub doDiff($$$$$$) { |
|
Line 1788 sub doDiff($$$$$$) { |
|
|
|
while (($re1, $re2) = each %funcline_regexp) { |
while (($re1, $re2) = each %funcline_regexp) { |
if ($fullname =~ /$re1/) { |
if ($fullname =~ /$re1/) { |
push @difftype, '-F', '$re2'; |
push @difftype, '-F', $re2; |
last; |
last; |
} |
} |
} |
} |
Line 2634 sub human_readable_diff($){ |
|
Line 2657 sub human_readable_diff($){ |
|
print "<br>Tag: $sym2\n" if ($sym1); |
print "<br>Tag: $sym2\n" if ($sym1); |
print "</th>\n"; |
print "</th>\n"; |
|
|
my $fs = "<font face=\"$difffontface\" size=\"$difffontsize\">"; |
my $fs = "<font face=\"$difffontface\" size=\"$difffontsize\"><tt>"; |
my $fe = "</font>"; |
my $fe = "</tt></font>"; |
|
|
my $leftRow = 0; |
my $leftRow = 0; |
my $rightRow = 0; |
my $rightRow = 0; |
Line 2657 sub human_readable_diff($){ |
|
Line 2680 sub human_readable_diff($){ |
|
|
|
if ($difftxt =~ /^@@/) { |
if ($difftxt =~ /^@@/) { |
($oldline,$newline,$funname) = $difftxt =~ /@@ \-([0-9]+).*\+([0-9]+).*@@(.*)/; |
($oldline,$newline,$funname) = $difftxt =~ /@@ \-([0-9]+).*\+([0-9]+).*@@(.*)/; |
|
$funname = htmlquote($funname); |
print "<tr bgcolor=\"$diffcolorHeading\"><td width=\"50%\">"; |
print "<tr bgcolor=\"$diffcolorHeading\"><td width=\"50%\">"; |
print "<table width=\"100%\" border=1 cellpadding=5><tr><td><b>Line $oldline</b>"; |
print "<table width=\"100%\" border=1 cellpadding=5><tr><td><b>Line $oldline</b>"; |
print " <font size=-1>$funname</font></td></tr></table>"; |
print " <font size=-1>$funname</font></td></tr></table>"; |
Line 2751 sub human_readable_diff($){ |
|
Line 2775 sub human_readable_diff($){ |
|
sub navigateHeader($$$$$) { |
sub navigateHeader($$$$$) { |
my ($swhere,$path,$filename,$rev,$title) = @_; |
my ($swhere,$path,$filename,$rev,$title) = @_; |
$swhere = "" if ($swhere eq $scriptwhere); |
$swhere = "" if ($swhere eq $scriptwhere); |
$swhere = urlencode($filename) if ($swhere eq ""); |
$swhere = './' . urlencode($filename) if ($swhere eq ""); |
print qq`<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">`; |
|
print "<HTML>\n<HEAD>\n"; |
print <<EOF; |
print qq`<META name="robots" content="nofollow">\n`; |
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"> |
print '<!-- CVSweb $zRevision: 1.104 $ $kRevision: 1.63 $ -->'; |
<HTML> |
print "\n<TITLE>$path$filename - $title - $rev</TITLE></HEAD>\n"; |
<HEAD> |
print "$body_tag_for_src\n"; |
<META name="robots" content="nofollow"> |
print "<table width=\"100%\" border=0 cellspacing=0 cellpadding=1 bgcolor=\"$navigationHeaderColor\">"; |
<!-- knu-cvsweb $cvsweb_revision --> |
print "<tr valign=bottom><td>"; |
<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 &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 "</b> $fileicon</td>"; |
|
|
print "<td align=right>$diricon <b>Up to ", &clickablePath($path, 1), "</b></td>"; |
print "<td align=right>$diricon <b>Up to ", &clickablePath($path, 1), "</b></td>"; |
Line 2979 sub download_link($$$;$) { |
|
Line 3008 sub download_link($$$;$) { |
|
my ($url, $revision, $textlink, $mimetype) = @_; |
my ($url, $revision, $textlink, $mimetype) = @_; |
my ($fullurl) = download_url($url, $revision, $mimetype); |
my ($fullurl) = download_url($url, $revision, $mimetype); |
|
|
|
$fullurl =~ s/:/sprintf("%%%02x", ord($&))/eg; |
|
|
printf '<A HREF="%s"', hrefquote("$fullurl$barequery"); |
printf '<A HREF="%s"', hrefquote("$fullurl$barequery"); |
|
|
if ($open_extern_window && (!defined($mimetype) || $mimetype ne "text/x-cvsweb-markup")) { |
if ($open_extern_window && (!defined($mimetype) || $mimetype ne "text/x-cvsweb-markup")) { |
Line 3150 sub http_header(;$) { |
|
Line 3181 sub http_header(;$) { |
|
|
|
sub html_header($) { |
sub html_header($) { |
my ($title) = @_; |
my ($title) = @_; |
my $version = '$zRevision: 1.104 $ $kRevision: 1.63 $'; #' |
|
http_header("text/html"); |
http_header("text/html"); |
print <<EOH; |
print <<EOH; |
<!doctype html public "-//W3C//DTD HTML 4.0 Transitional//EN" |
<!doctype html public "-//W3C//DTD HTML 4.0 Transitional//EN" |
Line 3159 sub html_header($) { |
|
Line 3189 sub html_header($) { |
|
<head> |
<head> |
<meta name="robots" content="nofollow"> |
<meta name="robots" content="nofollow"> |
<title>$title</title> |
<title>$title</title> |
<!-- CVSweb $version --> |
<!-- knu-cvsweb $cvsweb_revision --> |
</head> |
</head> |
$body_tag |
$body_tag |
$logo <h1 align="center">$title</h1> |
$logo <h1 align="center">$title</h1> |
Line 3176 sub link_tags($) { |
|
Line 3206 sub link_tags($) { |
|
my ($fileurl,$filename); |
my ($fileurl,$filename); |
|
|
($filename = $where) =~ s/^.*\///; |
($filename = $where) =~ s/^.*\///; |
$fileurl = urlencode($filename); |
$fileurl = './' . urlencode($filename); |
|
|
foreach my $sym (split(", ", $tags)) { |
foreach my $sym (split(", ", $tags)) { |
$ret .= ",\n" if ($ret ne ""); |
$ret .= ",\n" if ($ret ne ""); |