version 1.1.1.18, 2001/01/01 23:55:44 |
version 1.1.1.19, 2001/01/02 12:41:38 |
|
|
#!/usr/bin/perl5 -ws |
#!/usr/bin/perl -wT |
# |
# |
# cvsweb - a CGI interface to CVS trees. |
# cvsweb - a CGI interface to CVS trees. |
# |
# |
|
|
# SUCH DAMAGE. |
# SUCH DAMAGE. |
# |
# |
# $zId: cvsweb.cgi,v 1.104 2000/11/01 22:05:12 hnordstrom Exp $ |
# $zId: cvsweb.cgi,v 1.104 2000/11/01 22:05:12 hnordstrom Exp $ |
# $kId: cvsweb.cgi,v 1.54 2001/01/01 23:15:02 knu Exp $ |
# $kId: cvsweb.cgi,v 1.55 2001/01/02 12:23:20 knu Exp $ |
# |
# |
### |
### |
|
|
|
require 5.000; |
|
|
use strict; |
use strict; |
|
|
use vars qw ( |
use vars qw ( |
Line 130 sub link_tags($); |
|
Line 132 sub link_tags($); |
|
sub forbidden_module($); |
sub forbidden_module($); |
|
|
##### Start of Configuration Area ######## |
##### Start of Configuration Area ######## |
use Cwd; |
use File::Basename; |
|
|
# == EDIT this == |
# == EDIT this == |
# Locations to search for user configuration, in order: |
# Locations to search for user configuration, in order: |
for ( |
for ( |
$ENV{CVSWEB_CONFIG}, |
(dirname $0) . '/cvsweb.conf', |
'/usr/local/etc/cvsweb.conf', |
'/usr/local/etc/cvsweb.conf' |
getcwd() . '/cvsweb.conf' |
|
) { |
) { |
$config = $_ if defined($_) && -r $_; |
if (defined($_) && -r $_) { |
|
($config) = /(.*)/; # untaint |
|
last; |
|
} |
} |
} |
|
|
# == Configuration defaults == |
# == Configuration defaults == |
Line 482 if ($module && &forbidden_module($module)) { |
|
Line 486 if ($module && &forbidden_module($module)) { |
|
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; |
$where =~ s,/[^/]*$,,; |
my($module) = ($where =~ m,^/?(.*),); # untaint |
$where =~ s,^/,,; |
$module =~ s,/[^/]*$,,; |
my($basedir) = ($where =~ m,([^/]+)$,); |
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."); |
&fatal("500 Internal Error", "You cannot download the top level directory."); |
} |
} |
|
|
Line 497 if ($input{tarball}) { |
|
Line 501 if ($input{tarball}) { |
|
|
|
my $fatal = ''; |
my $fatal = ''; |
|
|
do { |
while (1) { |
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}) |
my $tag = (exists $input{only_with_tag} && length $input{only_with_tag}) |
? $input{only_with_tag} : "HEAD"; |
? $input{only_with_tag} : "HEAD"; |
|
|
system "cvs", @cvs_options, "-Qd", $cvsroot, "export", "-r", $tag, $where |
system "cvs", @cvs_options, "-Qd", $cvsroot, "export", "-r", $tag, "-d", "$tmpdir/$basedir", $module |
and $fatal = "500 Internal Error","cvs co failure: $!: $where" |
and $fatal = "500 Internal Error","cvs co failure: $!: $module" |
&& last; |
&& last; |
|
|
chdir "$where/.." |
|
or $fatal = "500 Internal Error","Cannot find expected directory in checkout" |
|
&& last; |
|
|
|
$| = 1; # Essential to get the buffering right. |
$| = 1; # Essential to get the buffering right. |
|
|
print "Content-type: application/x-gzip\r\n\r\n"; |
print "Content-type: application/x-gzip\r\n\r\n"; |
|
|
system "tar", "-zcf", "-", $basedir, @tar_options |
system "tar", @tar_options, "-zcf", "-", "-C", $tmpdir, $basedir |
and $fatal = "500 Internal Error","tar zc failure: $!: $basedir" |
and $fatal = "500 Internal Error","tar zc failure: $!: $basedir" |
&& last; |
&& last; |
|
|
chdir $tmpdir |
last; |
or $fatal = "500 Internal Error","Unable to cd to temporary directory: $!" |
} |
&& last; |
|
} while (0); |
|
|
|
system "rm", "-rf", $tmpdir if -d $tmpdir; |
system "rm", "-rf", $tmpdir if -d $tmpdir; |
|
|
Line 1372 sub doAnnotate($$) { |
|
Line 1366 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 -l server") || fatal ("500 Internal Error", |
$pid = open2($reader, $writer, "cvs", @cvs_options, "server") |
"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: |
# Root /home/kingdon/zwork/cvsroot |
# Root /home/kingdon/zwork/cvsroot |
Line 2721 sub navigateHeader($$$$$) { |
|
Line 2715 sub navigateHeader($$$$$) { |
|
print qq`<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">`; |
print qq`<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">`; |
print "<HTML>\n<HEAD>\n"; |
print "<HTML>\n<HEAD>\n"; |
print qq`<META name="robots" content="nofollow">\n`; |
print qq`<META name="robots" content="nofollow">\n`; |
print '<!-- CVSweb $zRevision: 1.104 $ $kRevision: 1.54 $ -->'; |
print '<!-- CVSweb $zRevision: 1.104 $ $kRevision: 1.55 $ -->'; |
print "\n<TITLE>$path$filename - $title - $rev</TITLE></HEAD>\n"; |
print "\n<TITLE>$path$filename - $title - $rev</TITLE></HEAD>\n"; |
print "$body_tag_for_src\n"; |
print "$body_tag_for_src\n"; |
print "<table width=\"100%\" border=0 cellspacing=0 cellpadding=1 bgcolor=\"$navigationHeaderColor\">"; |
print "<table width=\"100%\" border=0 cellspacing=0 cellpadding=1 bgcolor=\"$navigationHeaderColor\">"; |
Line 3115 sub http_header(;$) { |
|
Line 3109 sub http_header(;$) { |
|
|
|
sub html_header($) { |
sub html_header($) { |
my ($title) = @_; |
my ($title) = @_; |
my $version = '$zRevision: 1.104 $ $kRevision: 1.54 $'; #' |
my $version = '$zRevision: 1.104 $ $kRevision: 1.55 $'; #' |
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" |