version 1.1.1.28, 2001/08/01 10:24:01 |
version 1.1.1.35, 2002/09/30 19:43:49 |
|
|
# cvsweb - a CGI interface to CVS trees. |
# cvsweb - a CGI interface to CVS trees. |
# |
# |
# Written in their spare time by |
# Written in their spare time by |
# Bill Fenner <fenner@FreeBSD.org> (original work) |
# Bill Fenner <fenner@FreeBSD.org> (original work) |
# extended by Henner Zeller <zeller@think.de>, |
# extended by Henner Zeller <zeller@think.de>, |
# Henrik Nordstrom <hno@hem.passagen.se> |
# Henrik Nordstrom <hno@hem.passagen.se> |
# Ken Coar <coar@Apache.Org> |
# Ken Coar <coar@Apache.Org> |
# Dick Balaska <dick@buckosoft.com> |
# Dick Balaska <dick@buckosoft.com> |
# Akinori MUSHA <knu@FreeBSD.org> |
# Akinori MUSHA <knu@FreeBSD.org> |
# Jens-Uwe Mager <jum@helios.de> |
# Jens-Uwe Mager <jum@helios.de> |
|
# Ville Skyttä <scop@FreeBSD.org> |
|
# Vassilii Khachaturov <vassilii@tarunz.org> |
# |
# |
# Based on: |
# Based on: |
# * Bill Fenners cvsweb.cgi revision 1.28 available from: |
# * Bill Fenners cvsweb.cgi revision 1.28 available from: |
|
|
# |
# |
# 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-2001 Akinori MUSHA |
# (c) 2000-2002 Akinori MUSHA |
|
# (c) 2002 Ville Skyttä |
# 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. |
# |
# |
|
# FreeBSD: projects/cvsweb/cvsweb.cgi,v 1.119 2002/07/23 13:58:32 scop 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.82 2001/08/01 09:54:52 knu Exp $ |
# $Idaemons: /home/cvs/cvsweb/cvsweb.cgi,v 1.84 2001/10/07 20:50:10 knu Exp $ |
|
# $FreeBSD: www/en/cgi/cvsweb.cgi,v 1.86 2002/09/26 22:18:25 scop Exp $ |
# |
# |
### |
### |
|
|
|
|
@revisions %state %difflines %log %branchpoint @revorder |
@revisions %state %difflines %log %branchpoint @revorder |
$prcgi @prcategories $re_prcategories $prkeyword $re_prkeyword $mancgi |
$prcgi @prcategories $re_prcategories $prkeyword $re_prkeyword $mancgi |
$checkoutMagic $doCheckout $scriptname $scriptwhere |
$checkoutMagic $doCheckout $scriptname $scriptwhere |
$where $pathinfo $Browser $nofilelinks $maycompress @stickyvars |
$where $pathinfo $Browser $nofilelinks $maycompress |
|
@stickyvars @unsafevars |
%funcline_regexp $is_mod_perl |
%funcline_regexp $is_mod_perl |
$is_links $is_lynx $is_w3m $is_msie $is_mozilla3 $is_textbased |
$is_links $is_lynx $is_w3m $is_msie $is_mozilla3 $is_textbased |
%input $query $barequery $sortby $bydate $byrev $byauthor |
%input $query $barequery $sortby $bydate $byrev $byauthor |
$bylog $byfile $defaultDiffType $logsort $cvstree $cvsroot |
$bylog $byfile $defaultDiffType $logsort $cvstree $cvsroot |
$mimetype $charset $defaultTextPlain $defaultViewable |
$mimetype $charset $output_filter $defaultTextPlain $defaultViewable |
$command_path %CMD $allow_compress |
$command_path %CMD $allow_compress |
$backicon $diricon $fileicon |
$backicon $diricon $fileicon |
$fullname $newname $cvstreedefault |
$fullname $newname $cvstreedefault |
|
|
$columnHeaderColorSorted $hr_breakable $showfunc $hr_ignwhite |
$columnHeaderColorSorted $hr_breakable $showfunc $hr_ignwhite |
$hr_ignkeysubst $diffcolorHeading $diffcolorEmpty $diffcolorRemove |
$hr_ignkeysubst $diffcolorHeading $diffcolorEmpty $diffcolorRemove |
$diffcolorChange $diffcolorAdd $diffcolorDarkChange $difffontface |
$diffcolorChange $diffcolorAdd $diffcolorDarkChange $difffontface |
$difffontsize $inputTextSize $mime_types $allow_annotate |
$difffontsize $inputTextSize $mime_types |
$allow_markup $use_java_script $open_extern_window |
$allow_annotate $allow_markup |
|
$allow_log_extra $allow_dir_extra $allow_source_extra |
|
$use_java_script $open_extern_window |
$extern_window_width $extern_window_height $edit_option_form |
$extern_window_width $extern_window_height $edit_option_form |
$show_subdir_lastmod $show_log_in_markup $preformat_in_markup $v |
$show_subdir_lastmod $show_log_in_markup $preformat_in_markup $v |
$navigationHeaderColor $tableBorderColor $markupLogColor |
$navigationHeaderColor $tableBorderColor $markupLogColor |
|
|
$use_moddate $has_zlib $gzip_open |
$use_moddate $has_zlib $gzip_open |
$allow_tar @tar_options @gzip_options @zip_options @cvs_options |
$allow_tar @tar_options @gzip_options @zip_options @cvs_options |
$LOG_FILESEPARATOR $LOG_REVSEPARATOR |
$LOG_FILESEPARATOR $LOG_REVSEPARATOR |
$tmpdir |
$tmpdir $HTML_DOCTYPE $HTML_META |
); |
); |
|
|
sub printDiffSelect($); |
sub printDiffSelect($); |
Line 99 sub htmlify($;$); |
|
Line 107 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($); |
sub getMimeTypeFromSuffix($); |
sub getMimeTypeFromSuffix($); |
sub head($;$); |
sub head($;$); |
sub scan_directives(@); |
sub scan_directives(@); |
|
sub openOutputFilter(); |
sub doAnnotate($$); |
sub doAnnotate($$); |
sub doCheckout($$); |
sub doCheckout($$); |
sub cvswebMarkup($$$); |
sub cvswebMarkup($$$); |
Line 141 sub forbidden_module($); |
|
Line 150 sub forbidden_module($); |
|
##### Start of Configuration Area ######## |
##### Start of Configuration Area ######## |
delete $ENV{PATH}; |
delete $ENV{PATH}; |
|
|
$cvsweb_revision = |
$cvsweb_revision = '2.0.5'; |
'1.112' . '.' . ( |
|
split (/ /, |
|
q$Idaemons: /home/cvs/cvsweb/cvsweb.cgi,v 1.82 2001/08/01 09:54:52 knu Exp $ |
|
))[2]; |
|
|
|
use File::Basename; |
use File::Basename (); |
|
|
($mydir) = (dirname($0) =~ /(.*)/); # untaint |
($mydir) = (File::Basename::dirname($0) =~ /(.*)/); # untaint |
|
|
# == EDIT this == |
# == EDIT this == |
# Locations to search for user configuration, in order: |
# Locations to search for user configuration, in order: |
Line 164 for ("$mydir/cvsweb.conf", '/usr/local/etc/cvsweb/cvsw |
|
Line 169 for ("$mydir/cvsweb.conf", '/usr/local/etc/cvsweb/cvsw |
|
# Defaults for configuration variables that shouldn't need |
# Defaults for configuration variables that shouldn't need |
# to be configured.. |
# to be configured.. |
$allow_version_select = 1; |
$allow_version_select = 1; |
|
$allow_log_extra = 1; |
|
|
##### End of Configuration Area ######## |
##### End of Configuration Area ######## |
|
|
Line 182 $cvstreedefault = $body_tag = $body_tag_for_src = $log |
|
Line 188 $cvstreedefault = $body_tag = $body_tag_for_src = $log |
|
$extern_window_width = $extern_window_height = $edit_option_form = |
$extern_window_width = $extern_window_height = $edit_option_form = |
$show_subdir_lastmod = $show_log_in_markup = $v = $navigationHeaderColor = |
$show_subdir_lastmod = $show_log_in_markup = $v = $navigationHeaderColor = |
$tableBorderColor = $markupLogColor = $tabstop = $use_moddate = $moddate = |
$tableBorderColor = $markupLogColor = $tabstop = $use_moddate = $moddate = |
$gzip_open = undef; |
$gzip_open = $HTML_DOCTYPE = $HTML_META = undef; |
$tmpdir = defined($ENV{TMPDIR}) ? $ENV{TMPDIR} : "/var/tmp"; |
$tmpdir = defined($ENV{TMPDIR}) ? $ENV{TMPDIR} : "/var/tmp"; |
|
|
$LOG_FILESEPARATOR = q/^={77}$/; |
$LOG_FILESEPARATOR = q/^={77}$/; |
Line 230 $LOG_REVSEPARATOR = q/^-{28}$/; |
|
Line 236 $LOG_REVSEPARATOR = q/^-{28}$/; |
|
}, |
}, |
); |
); |
|
|
|
$cgi_style::hsty_base = 'http://www.FreeBSD.org'; |
|
$_ = q$FreeBSD: www/en/cgi/cvsweb.cgi,v 1.86 2002/09/26 22:18:25 scop Exp $; |
|
@_ = split; |
|
$cgi_style::hsty_date = "@_[3,4]"; |
|
|
|
# warningproof |
|
0 if $cgi_style::hsty_base ne $cgi_style::hsty_date; |
|
|
|
package cgi_style; |
|
require "$main::mydir/cgi-style.pl"; |
|
package main; |
|
|
|
$HTML_DOCTYPE = |
|
'<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">'; |
|
|
|
$HTML_META = <<EOM; |
|
<meta name="robots" content="nofollow"> |
|
<meta name="generator" content="FreeBSD-CVSweb $cvsweb_revision"> |
|
<meta http-equiv="Content-Script-Type" content="text/javascript"> |
|
<meta http-equiv="Content-Style-Type" content="text/css"> |
|
EOM |
|
|
##### End of configuration variables ##### |
##### End of configuration variables ##### |
|
|
use Time::Local; |
use Time::Local (); |
use IPC::Open2; |
use IPC::Open2 qw(open2); |
|
|
# Check if the zlib C library interface is installed, and if yes |
# Check if the zlib C library interface is installed, and if yes |
# we can avoid using the extra gzip process. |
# we can avoid using the extra gzip process. |
|
|
# their current value) to any link/query string |
# their current value) to any link/query string |
# you construct |
# you construct |
@stickyvars = qw(cvsroot hideattic sortby logsort f only_with_tag); |
@stickyvars = qw(cvsroot hideattic sortby logsort f only_with_tag); |
|
@unsafevars = qw(logsort only_with_tag r1 r2 rev sortby tr1 tr2); |
|
|
if (-f $config) { |
if (-f $config) { |
require $config || &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 332 if (defined($query) && $query ne '') { |
|
Line 355 if (defined($query) && $query ne '') { |
|
$input{only_with_tag} = $input{only_on_branch} |
$input{only_with_tag} = $input{only_on_branch} |
if (defined($input{only_on_branch})); |
if (defined($input{only_on_branch})); |
|
|
|
# Prevent cross-site scripting |
|
foreach (@unsafevars) { |
|
# Colons are needed in diffs between tags. |
|
if (defined($input{$_}) && $input{$_} =~ /[^\w\-.:]/) { |
|
fatal("500 Internal Error", |
|
'Malformed query (%s=%s)', |
|
$_, $input{$_}); |
|
} |
|
} |
|
|
|
if (defined($input{"content-type"})) { |
|
fatal("500 Internal Error", "Unsupported content-type") |
|
if ($input{"content-type"} !~ /^[-0-9A-Za-z]+\/[-0-9A-Za-z]+$/); |
|
} |
|
|
$DEFAULTVALUE{'cvsroot'} = $cvstreedefault; |
$DEFAULTVALUE{'cvsroot'} = $cvstreedefault; |
|
|
foreach (keys %DEFAULTVALUE) { |
foreach (keys %DEFAULTVALUE) { |
Line 410 $defaultDiffType = $input{'f'}; |
|
Line 448 $defaultDiffType = $input{'f'}; |
|
|
|
$logsort = $input{'logsort'}; |
$logsort = $input{'logsort'}; |
|
|
my @tmp = @CVSrepositories; |
{ |
my @pair; |
my @tmp = @CVSrepositories; |
|
my @pair; |
|
|
while (@pair = splice(@tmp, 0, 2)) { |
while (@pair = splice(@tmp, 0, 2)) { |
my ($key, $val) = @pair; |
my ($key, $val) = @pair; |
my ($descr, $cvsroot) = @$val; |
my ($descr, $cvsroot) = @$val; |
|
|
next if !-d $cvsroot; |
next if !-d $cvsroot; |
|
|
$CVSROOTdescr{$key} = $descr; |
$CVSROOTdescr{$key} = $descr; |
$CVSROOT{$key} = $cvsroot; |
$CVSROOT{$key} = $cvsroot; |
push @CVSROOT, $key; |
push @CVSROOT, $key; |
|
} |
} |
} |
undef @tmp; |
|
undef @pair; |
|
|
|
## 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 451 foreach $k (keys %ICONS) { |
|
Line 488 foreach $k (keys %ICONS) { |
|
if ($ipath) { |
if ($ipath) { |
${"${k}icon"} = |
${"${k}icon"} = |
sprintf( |
sprintf( |
'<IMG SRC="%s" ALT="%s" BORDER="0" WIDTH="%d" HEIGHT="%d">', |
'<img src="%s" alt="%s" border="0" width="%d" height="%d">', |
hrefquote($ipath), htmlquote($itxt), $iwidth, $iheight) |
hrefquote($ipath), htmlquote($itxt), $iwidth, $iheight) |
} else { |
} else { |
${"${k}icon"} = $itxt; |
${"${k}icon"} = $itxt; |
Line 463 my $config_cvstree = "$config-$cvstree"; |
|
Line 500 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) { |
require $config_cvstree || &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 518 if (!-d $cvsroot) { |
|
Line 550 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 533 if ($input{tarball}) { |
|
Line 568 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 $tmpdir = "/tmp/.cvsweb.$$." . int(time); |
my $tmpexportdir = "$tmpdir/.cvsweb.$$." . int(time); |
|
|
mkdir($tmpdir, 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 549 if ($input{tarball}) { |
|
Line 585 if ($input{tarball}) { |
|
(exists $input{only_with_tag} && length $input{only_with_tag}) ? |
(exists $input{only_with_tag} && length $input{only_with_tag}) ? |
$input{only_with_tag} : "HEAD"; |
$input{only_with_tag} : "HEAD"; |
|
|
|
if ($tag eq 'MAIN') { |
|
$tag = 'HEAD'; |
|
} |
|
|
if (system $CMD{cvs}, @cvs_options, '-Qd', $cvsroot, 'export', '-r', |
if (system $CMD{cvs}, @cvs_options, '-Qd', $cvsroot, 'export', '-r', |
$tag, '-d', "$tmpdir/$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. |
|
|
if ($ext eq '.tar.gz') { |
if ($ext eq '.tar.gz') { |
print "Content-type: application/x-gzip\r\n\r\n"; |
print "Content-Type: application/x-gzip\r\n\r\n"; |
|
|
system |
system |
"$CMD{tar} @tar_options -cf - -C $tmpdir $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 $tmpdir && $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'); |
} |
} |
} |
} |
|
|
system $CMD{rm}, '-rf', $tmpdir if -d $tmpdir; |
system $CMD{rm}, '-rf', $tmpexportdir if -d $tmpexportdir; |
|
|
&fatal(@fatal) if @fatal; |
&fatal(@fatal) if @fatal; |
|
|
Line 589 if ($input{tarball}) { |
|
Line 635 if ($input{tarball}) { |
|
############################### |
############################### |
if (-d $fullname) { |
if (-d $fullname) { |
my $dh = do { local (*DH); }; |
my $dh = do { local (*DH); }; |
opendir($dh, $fullname) || &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 605 if (-d $fullname) { |
|
Line 653 if (-d $fullname) { |
|
print $short_instruction; |
print $short_instruction; |
} |
} |
|
|
my $descriptions; |
if ($use_descriptions && open(DESC, "<$cvsroot/CVSROOT/descriptions")) |
if (($use_descriptions) && open(DESC, "<$cvsroot/CVSROOT/descriptions")) |
|
{ |
{ |
while (<DESC>) { |
while (<DESC>) { |
chomp; |
chomp; |
my ($dir, $description) = /(\S+)\s+(.*)/; |
my ($dir, $description) = /(\S+)\s+(.*)/; |
$descriptions{$dir} = $description; |
$descriptions{$dir} = $description; |
} |
} |
|
close(DESC); |
} |
} |
|
|
print "<P><a name=\"dirlist\"></a>\n"; |
print "<p><a name=\"dirlist\"></a></p>\n"; |
|
|
# give direct access to dirs |
# give direct access to dirs |
if ($where eq '/') { |
if ($where eq '/') { |
Line 623 if (-d $fullname) { |
|
Line 671 if (-d $fullname) { |
|
chooseCVSRoot (); |
chooseCVSRoot (); |
} else { |
} else { |
print "<p>Current directory: <b>", &clickablePath($where, 0), |
print "<p>Current directory: <b>", &clickablePath($where, 0), |
"</b>\n"; |
"</b></p>\n"; |
|
|
print "<P>Current tag: <B>", $input{only_with_tag}, "</b>\n" |
print "<p>Current tag: <b>", $input{only_with_tag},"</b></p>\n" |
if $input{only_with_tag}; |
if $input{only_with_tag}; |
|
|
} |
} |
|
|
print "<HR NOSHADE>\n"; |
print "<hr noshade>\n"; |
|
|
# Using <MENU> in this manner violates the HTML2.0 spec but |
# Using <menu> in this manner violates the HTML2.0 spec but |
# provides the results that I want in most browsers. Another |
# provides the results that I want in most browsers. Another |
# case of layout spooging up HTML. |
# case of layout spooging up HTML. |
|
|
my $infocols = 0; |
my $infocols = 0; |
if ($dirtable) { |
if ($dirtable) { |
if (defined($tableBorderColor)) { |
print "<table style=\"border-width: 0"; |
|
print "; background-color: $tableBorderColor" |
# Can't this be done by defining the border for the inner table? |
if (defined $tableBorderColor); |
print |
print "\" width=\"100%\" cellspacing=\"1\" cellpadding=\"$tablepadding\">\n"; |
"<table border=0 cellpadding=0 width=\"100%\"><tr><td bgcolor=\"$tableBorderColor\">"; |
|
} |
|
print |
|
"<table width=\"100%\" border=0 cellspacing=1 cellpadding=$tablepadding>\n"; |
|
$infocols++; |
$infocols++; |
printf '<tr><th align=left bgcolor="%s">', |
printf "<tr>\n<th style=\"text-align: left; background-color: %s\">", |
$byfile ? $columnHeaderColorSorted : |
$byfile ? $columnHeaderColorSorted : |
$columnHeaderColorDefault; |
$columnHeaderColorDefault; |
|
|
Line 662 if (-d $fullname) { |
|
Line 706 if (-d $fullname) { |
|
) |
) |
); |
); |
} |
} |
print "</th>"; |
print "</th>\n"; |
|
|
# do not display the other column-headers, if we do not have any files |
# do not display the other column-headers, if we do not have any files |
# with revision information: |
# with revision information: |
if (scalar(%fileinfo)) { |
if (scalar(%fileinfo)) { |
$infocols++; |
$infocols++; |
printf '<th align=left bgcolor="%s">', |
printf '<th style="text-align: left; background-color: %s">', |
$byrev ? $columnHeaderColorSorted : |
$byrev ? $columnHeaderColorSorted : |
$columnHeaderColorDefault; |
$columnHeaderColorDefault; |
|
|
Line 683 if (-d $fullname) { |
|
Line 727 if (-d $fullname) { |
|
) |
) |
); |
); |
} |
} |
print "</th>"; |
print "</th>\n"; |
$infocols++; |
$infocols++; |
printf '<th align=left bgcolor="%s">', |
printf '<th style="text-align: left; background-color: %s">', |
$bydate ? $columnHeaderColorSorted : |
$bydate ? $columnHeaderColorSorted : |
$columnHeaderColorDefault; |
$columnHeaderColorDefault; |
|
|
Line 700 if (-d $fullname) { |
|
Line 744 if (-d $fullname) { |
|
) |
) |
); |
); |
} |
} |
print "</th>"; |
print "</th>\n"; |
|
|
if ($show_author) { |
if ($show_author) { |
$infocols++; |
$infocols++; |
printf '<th align=left bgcolor="%s">', |
printf '<th style="text-align: left; background-color: %s">', |
$byauthor ? $columnHeaderColorSorted : |
$byauthor ? $columnHeaderColorSorted : |
$columnHeaderColorDefault; |
$columnHeaderColorDefault; |
|
|
Line 722 if (-d $fullname) { |
|
Line 766 if (-d $fullname) { |
|
) |
) |
); |
); |
} |
} |
print "</th>"; |
print "</th>\n"; |
} |
} |
$infocols++; |
$infocols++; |
printf '<th align=left bgcolor="%s">', |
printf '<th style="text-align: left; background-color: %s">', |
$bylog ? $columnHeaderColorSorted : |
$bylog ? $columnHeaderColorSorted : |
$columnHeaderColorDefault; |
$columnHeaderColorDefault; |
|
|
Line 740 if (-d $fullname) { |
|
Line 784 if (-d $fullname) { |
|
) |
) |
); |
); |
} |
} |
print "</th>"; |
print "</th>\n"; |
} elsif ($use_descriptions) { |
} elsif ($use_descriptions) { |
printf '<th align=left bgcolor="%s">', |
printf '<th style="text-align: left; background-color: s">', |
$columnHeaderColorDefault; |
$columnHeaderColorDefault; |
print "Description"; |
print "Description</th>\n"; |
$infocols++; |
$infocols++; |
} |
} |
print "</tr>\n"; |
print "</tr>\n"; |
Line 810 if (-d $fullname) { |
|
Line 854 if (-d $fullname) { |
|
($rev, $date, $log, $author, $filename) = |
($rev, $date, $log, $author, $filename) = |
@{$fileinfo{$_}} |
@{$fileinfo{$_}} |
if (defined($fileinfo{$_})); |
if (defined($fileinfo{$_})); |
printf '<tr bgcolor="%s"><td>', $tabcolors[$dirrow % 2] |
printf "<tr style=\"background-color: %s\">\n<td>", |
if $dirtable; |
$tabcolors[$dirrow % 2] if $dirtable; |
|
|
if ($_ eq '..') { |
if ($_ eq '..') { |
$url = "../$query"; |
$url = "../$query"; |
Line 820 if (-d $fullname) { |
|
Line 864 if (-d $fullname) { |
|
} else { |
} else { |
print &link($backicon, $url); |
print &link($backicon, $url); |
} |
} |
print " ", &link("Parent 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; |
} else { |
} else { |
print &link($diricon, $url); |
print &link($diricon, $url); |
} |
} |
print " ", &link("$_/", $url), $attic; |
print ' ', &link("$_/", $url), $attic; |
|
|
if ($_ eq "Attic") { |
if ($_ eq "Attic") { |
print " "; |
print " "; |
Line 847 if (-d $fullname) { |
|
Line 891 if (-d $fullname) { |
|
|
|
# Show last change in dir |
# Show last change in dir |
if ($filename) { |
if ($filename) { |
print "</td><td> </td><td> " |
print "</td>\n<td> </td>\n<td> " |
if ($dirtable); |
if ($dirtable); |
if ($date) { |
if ($date) { |
print " <i>", |
print " <i>", |
Line 856 if (-d $fullname) { |
|
Line 900 if (-d $fullname) { |
|
} |
} |
|
|
if ($show_author) { |
if ($show_author) { |
print "</td><td> " if ($dirtable); |
print "</td>\n<td> " if ($dirtable); |
print $author; |
print $author; |
} |
} |
print "</td><td> " if ($dirtable); |
print "</td>\n<td> " if ($dirtable); |
$filename =~ s%^[^/]+/%%; |
$filename =~ s%^[^/]+/%%; |
print "$filename/$rev"; |
print "$filename/$rev"; |
print "<BR>" if ($dirtable); |
print "<br>" if ($dirtable); |
|
|
if ($log) { |
if ($log) { |
print " <font size=-1>", &htmlify( |
print " <span style=\"font-size: smaller\">", |
substr($log, 0, $shortLogLen)); |
&htmlify( |
|
substr($log, 0, $shortLogLen), $allow_dir_extra); |
if (length $log > 80) { |
if (length $log > 80) { |
print "..."; |
print "..."; |
} |
} |
print "</font>"; |
print "</span>"; |
} |
} |
} else { |
} else { |
my ($dwhere) = |
my ($dwhere) = |
Line 879 if (-d $fullname) { |
|
Line 924 if (-d $fullname) { |
|
if ($use_descriptions |
if ($use_descriptions |
&& defined $descriptions{$dwhere}) |
&& defined $descriptions{$dwhere}) |
{ |
{ |
print "<TD COLSPAN=", ($infocols - 1), |
print "<td colspan=\"",($infocols - 1), |
"> " |
"\"> " |
if $dirtable; |
if $dirtable; |
print $descriptions{$dwhere}; |
print $descriptions{$dwhere}; |
} elsif ($dirtable && $infocols > 1) { |
} elsif ($dirtable && $infocols > 1) { |
Line 889 if (-d $fullname) { |
|
Line 934 if (-d $fullname) { |
|
# columns, so that the vertical seperators are visible |
# columns, so that the vertical seperators are visible |
my ($cols) = $infocols; |
my ($cols) = $infocols; |
while ($cols > 1) { |
while ($cols > 1) { |
print "</td><td> "; |
print "</td>\n<td> "; |
$cols--; |
$cols--; |
} |
} |
} |
} |
} |
} |
|
|
if ($dirtable) { |
if ($dirtable) { |
print "</td></tr>\n"; |
print "</td>\n</tr>\n"; |
} else { |
} else { |
print "<br>\n"; |
print "<br>\n"; |
} |
} |
$dirrow++; |
$dirrow++; |
} elsif (s/,v$//) { |
} elsif (s/,v$//) { |
|
|
|
# Skip forbidden files now so we'll give no hint |
|
# about their existence. This should probably have |
|
# been done earlier, but it's straightforward here. |
|
next if forbidden_file("$fullname/$_"); |
|
|
$fileurl = ($attic ? "Attic/" : "") . urlencode($_); |
$fileurl = ($attic ? "Attic/" : "") . urlencode($_); |
$url = './' . $fileurl . $query; |
$url = './' . $fileurl . $query; |
my $rev = ''; |
my $rev = ''; |
Line 912 if (-d $fullname) { |
|
Line 963 if (-d $fullname) { |
|
next if (!defined($fileinfo{$_})); |
next if (!defined($fileinfo{$_})); |
($rev, $date, $log, $author) = @{$fileinfo{$_}}; |
($rev, $date, $log, $author) = @{$fileinfo{$_}}; |
$filesfound++; |
$filesfound++; |
printf '<tr bgcolor="%s"><td>', $tabcolors[$dirrow % 2] |
printf "<tr style=\"background-color: %s\">\n<td>", |
if $dirtable; |
$tabcolors[$dirrow % 2] if $dirtable; |
print "<A NAME=\"$_\"></A>"; |
print "<a name=\"$_\"></a>"; |
|
|
if ($nofilelinks) { |
if ($nofilelinks) { |
print $fileicon; |
print $fileicon; |
} else { |
} else { |
print &link($fileicon, $url); |
print &link($fileicon, $url); |
} |
} |
print " ", &link($_, $url), $attic; |
print ' ', &link($_, $url), $attic; |
print "</td><td> " if ($dirtable); |
print "</td>\n<td> " if ($dirtable); |
download_link($fileurl, $rev, $rev, |
download_link($fileurl, $rev, $rev, |
$defaultViewable ? "text/x-cvsweb-markup" : |
$defaultViewable ? "text/x-cvsweb-markup" : |
undef); |
undef); |
print "</td><td> " if ($dirtable); |
print "</td>\n<td> " if ($dirtable); |
|
|
if ($date) { |
if ($date) { |
print " <i>", readableTime(time() - $date, 0), |
print " <i>", readableTime(time() - $date, 0), |
"</i>"; |
"</i>"; |
} |
} |
if ($show_author) { |
if ($show_author) { |
print "</td><td> " if ($dirtable); |
print "</td>\n<td> " if ($dirtable); |
print $author; |
print $author; |
} |
} |
print "</td><td> " if ($dirtable); |
print "</td>\n<td> " if ($dirtable); |
|
|
if ($log) { |
if ($log) { |
print " <font size=-1>", |
print " <span style=\"font-size: smaller\">", |
&htmlify(substr($log, 0, $shortLogLen)); |
&htmlify(substr($log, 0, $shortLogLen), $allow_dir_extra); |
if (length $log > 80) { |
if (length $log > 80) { |
print "..."; |
print "..."; |
} |
} |
print "</font>"; |
print "</span>"; |
} |
} |
print "</td>" if ($dirtable); |
print "</td>\n" if ($dirtable); |
print(($dirtable) ? "</tr>" : "<br>"); |
print(($dirtable) ? "</tr>" : "<br>"); |
$dirrow++; |
$dirrow++; |
} |
} |
print "\n"; |
print "\n"; |
} |
} |
|
|
if ($dirtable && defined($tableBorderColor)) { |
print($dirtable ? "</table>\n" : "</menu>\n"); |
print "</td></tr></table>"; |
|
} |
|
print($dirtable == 1 ? "</table>\n" : "</menu>\n"); |
|
|
|
if ($filesexists && !$filesfound) { |
if ($filesexists && !$filesfound) { |
print |
print |
"<P><B>NOTE:</B> There are $filesexists files, but none matches the current tag ($input{only_with_tag})\n"; |
"<p><b>NOTE:</b> There are $filesexists files, but none matches the current tag ($input{only_with_tag}).</p>\n"; |
} |
} |
if ($input{only_with_tag} && (!%tags || !$tags{$input{only_with_tag}})) |
if ($input{only_with_tag} && (!%tags || !$tags{$input{only_with_tag}})) |
{ |
{ |
Line 970 if (-d $fullname) { |
|
Line 1018 if (-d $fullname) { |
|
if (scalar %tags || $input{only_with_tag} || $edit_option_form |
if (scalar %tags || $input{only_with_tag} || $edit_option_form |
|| defined($input{"options"})) |
|| defined($input{"options"})) |
{ |
{ |
print "<hr size=1 NOSHADE>"; |
print "<hr size=\"1\" noshade>\n"; |
} |
} |
|
|
if (scalar %tags || $input{only_with_tag}) { |
if (scalar %tags || $input{only_with_tag}) { |
print "<FORM METHOD=\"GET\" ACTION=\"./\">\n"; |
print "<form method=\"get\" action=\"./\">\n"; |
foreach my $var (@stickyvars) { |
foreach my $var (@stickyvars) { |
print |
print |
"<INPUT TYPE=HIDDEN NAME=\"$var\" VALUE=\"$input{$var}\">\n" |
"<input type=\"hidden\" name=\"$var\" value=\"$input{$var}\">\n" |
if (defined($input{$var}) |
if (defined($input{$var}) |
&& (!defined($DEFAULTVALUE{$var}) |
&& (!defined($DEFAULTVALUE{$var}) |
|| $input{$var} ne $DEFAULTVALUE{$var}) |
|| $input{$var} ne $DEFAULTVALUE{$var}) |
&& $input{$var} ne "" && $var ne "only_with_tag"); |
&& $input{$var} ne "" && $var ne "only_with_tag"); |
} |
} |
print "Show only files with tag:\n"; |
print "<p><label for=\"only_with_tag\" accesskey=\"T\">"; |
print "<SELECT NAME=only_with_tag"; |
print "Show only files with tag:</label>\n"; |
print " onchange=\"submit()\"" if ($use_java_script); |
print "<select id=\"only_with_tag\" name=\"only_with_tag\""; |
|
print " onchange=\"this.form.submit()\"" if $use_java_script; |
print ">"; |
print ">"; |
print "<OPTION VALUE=\"\">All tags / default branch\n"; |
print "<option value=\"\">All tags / default branch</option>\n"; |
|
|
foreach my $tag (reverse sort { lc $a cmp lc $b } keys %tags) { |
foreach my $tag (reverse sort { lc $a cmp lc $b } keys %tags) { |
print "<OPTION", |
print "<option", |
defined($input{only_with_tag}) |
defined($input{only_with_tag}) |
&& $input{only_with_tag} eq $tag ? " SELECTED" : "", |
&& $input{only_with_tag} eq $tag ? " selected" : "", |
">$tag\n"; |
">$tag</option>\n"; |
} |
} |
print "</SELECT>\n"; |
print "</select>\n"; |
print " Module path or alias:\n"; |
print " <label for=\"path\" accesskey=\"P\">"; |
printf "<INPUT TYPE=TEXT NAME=\"path\" VALUE=\"%s\" SIZE=15>\n", |
print "Module path or alias:</label>\n"; |
|
printf "<input type=\"text\" id=\"path\" name=\"path\" value=\"%s\" size=\"15\">\n", |
htmlquote($where); |
htmlquote($where); |
print "<INPUT TYPE=SUBMIT VALUE=\"Go\">\n"; |
print "<input type=\"submit\" value=\"Go\" accesskey=\"G\"></p>\n"; |
print "</FORM>\n"; |
print "</form>\n"; |
} |
} |
|
|
if ($allow_tar) { |
if ($allow_tar) { |
my ($basefile) = ($where =~ m,(?:.*/)?([^/]+),); |
my ($basefile) = ($where =~ m,(?:.*/)?([^/]+),); |
|
|
if (defined($basefile) && $basefile ne '') { |
if (defined($basefile) && $basefile ne '') { |
print "<HR NOSHADE>\n", |
print "<hr noshade>\n", |
"<DIV align=center>Download this directory in "; |
"<div align=\"center\">Download this directory in "; |
|
|
# Mangle the filename so browsers show a reasonable |
# Mangle the filename so browsers show a reasonable |
# filename to download. |
# filename to download. |
Line 1019 if (-d $fullname) { |
|
Line 1069 if (-d $fullname) { |
|
&link("zip archive", "./$basefile.zip$query" |
&link("zip archive", "./$basefile.zip$query" |
. ($query ? "&" : "?") . "tarball=1"); |
. ($query ? "&" : "?") . "tarball=1"); |
} |
} |
print "</DIV>"; |
print "</div>\n"; |
} |
} |
} |
} |
|
|
my $formwhere = $scriptwhere; |
|
$formwhere =~ s|Attic/?$|| if ($input{'hideattic'}); |
|
|
|
if ($edit_option_form || defined($input{"options"})) { |
if ($edit_option_form || defined($input{"options"})) { |
print "<FORM METHOD=\"GET\" ACTION=\"${formwhere}\">\n"; |
|
print "<INPUT TYPE=HIDDEN NAME=\"copt\" VALUE=\"1\">\n"; |
my $formwhere = $scriptwhere; |
|
$formwhere =~ s|Attic/?$|| if ($input{'hideattic'}); |
|
|
|
print "<form method=\"get\" action=\"${formwhere}\">\n"; |
|
print "<input type=\"hidden\" name=\"copt\" value=\"1\">\n"; |
if ($cvstree ne $cvstreedefault) { |
if ($cvstree ne $cvstreedefault) { |
print |
print |
"<INPUT TYPE=HIDDEN NAME=\"cvsroot\" VALUE=\"$cvstree\">\n"; |
"<input type=\"hidden\" name=\"cvsroot\" value=\"$cvstree\">\n"; |
} |
} |
print "<center><table cellpadding=0 cellspacing=0>"; |
print "<center>\n<table cellpadding=\"0\" cellspacing=\"0\">"; |
print |
print "\n<tr style=\"background-color: $columnHeaderColorDefault\">\n"; |
"<tr bgcolor=\"$columnHeaderColorDefault\"><th colspan=2>Preferences</th></tr>"; |
print "<th colspan=\"2\">Preferences</th>\n</tr>\n"; |
print "<tr><td>Sort files by <SELECT name=\"sortby\">"; |
print "<tr>\n<td>"; |
print "<OPTION VALUE=\"\">File"; |
print "<label for=\"sortby\" accesskey=\"F\">Sort files by "; |
print "<OPTION", $bydate ? " SELECTED" : "", " VALUE=date>Age"; |
print "</label><select id=\"sortby\" name=\"sortby\">\n"; |
print "<OPTION", $byauthor ? " SELECTED" : "", |
print "<option value=\"\">File</option>\n"; |
" VALUE=author>Author" |
print "<option", $bydate ? " selected" : "", |
|
" value=\"date\">Age</option>\n"; |
|
print "<option", $byauthor ? " selected" : "", |
|
" value=\"author\">Author</option>\n" |
if ($show_author); |
if ($show_author); |
print "<OPTION", $byrev ? " SELECTED" : "", |
print "<option", $byrev ? " selected" : "", |
" VALUE=rev>Revision"; |
" value=\"rev\">Revision</option>\n"; |
print "<OPTION", $bylog ? " SELECTED" : "", |
print "<option", $bylog ? " selected" : "", |
" VALUE=log>Log message"; |
" value=\"log\">Log message</option>\n"; |
print "</SELECT></td>"; |
print "</select>\n</td>\n"; |
print "<td>Sort log by: "; |
print "<td><label for=\"logsort\" accesskey=\"L\">"; |
|
print "Sort log by: </label>"; |
printLogSortSelect(0); |
printLogSortSelect(0); |
print "</td></tr>"; |
print "</td>\n</tr>\n"; |
print "<tr><td>Diff format: "; |
print "<tr>\n<td><label for=\"f\" accesskey=\"D\">"; |
|
print "Diff format: </label>"; |
printDiffSelect(0); |
printDiffSelect(0); |
print "</td>"; |
print "</td>\n"; |
print "<td>Show Attic files: "; |
print "<td><label for=\"hideattic\" accesskey=\"A\">"; |
print "<INPUT NAME=hideattic TYPE=CHECKBOX", |
print "Show Attic files: </label>"; |
$input{'hideattic'} ? " CHECKED" : "", "></td></tr>\n"; |
print "<input id=\"hideattic\" name=\"hideattic\" type=\"checkbox\"", |
print |
$input{'hideattic'} ? " checked" : "", |
"<tr><td align=center colspan=2><input type=submit value=\"Change Options\">"; |
"></td>\n</tr>\n"; |
print "</td></tr></table></center></FORM>\n"; |
print "<tr>\n<td align=\"center\" colspan=\"2\">"; |
|
print "<input type=\"submit\" value=\"Change Options\" accesskey=\"C\">"; |
|
print "</td>\n</tr>\n</table>\n</center>\n</form>\n"; |
} |
} |
print &html_footer; |
html_footer(); |
print "</BODY></HTML>\n"; |
|
} |
} |
|
|
############################### |
############################### |
# View Files |
# View Files |
############################### |
############################### |
elsif (-f $fullname . ',v') { |
elsif (-f $fullname . ',v') { |
|
|
|
if (forbidden_file($fullname)) { |
|
fatal('403 Forbidden', |
|
'Access forbidden. This file is mentioned in @ForbiddenFiles'); |
|
return; |
|
} |
|
|
if (defined($input{'rev'}) || $doCheckout) { |
if (defined($input{'rev'}) || $doCheckout) { |
&doCheckout($fullname, $input{'rev'}); |
&doCheckout($fullname, $input{'rev'}); |
gzipclose(); |
gzipclose(); |
Line 1120 elsif (-f $fullname . ',v') { |
|
Line 1184 elsif (-f $fullname . ',v') { |
|
# The file has been removed and is in the Attic. |
# The file has been removed and is in the Attic. |
# Send a redirect pointing to the file in the Attic. |
# Send a redirect pointing to the file in the Attic. |
(my $newplace = $scriptwhere) =~ s|/([^/]+)$|/Attic/$1|; |
(my $newplace = $scriptwhere) =~ s|/([^/]+)$|/Attic/$1|; |
redirect("$newplace$query"); |
if ($ENV{QUERY_STRING} ne "") { |
|
redirect("${newplace}?$ENV{QUERY_STRING}"); |
|
} else { |
|
redirect($newplace); |
|
} |
exit; |
exit; |
} elsif (0 && (my @files = &safeglob($fullname . ",v"))) { |
} elsif (0 && (my @files = &safeglob($fullname . ",v"))) { |
http_header("text/plain"); |
http_header("text/plain"); |
Line 1146 elsif (-f $fullname . ',v') { |
|
Line 1214 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 1157 sub printDiffSelect($) { |
|
Line 1227 sub printDiffSelect($) { |
|
my ($use_java_script) = @_; |
my ($use_java_script) = @_; |
my $f = $input{'f'}; |
my $f = $input{'f'}; |
|
|
print '<SELECT NAME="f"'; |
print '<select id="f" name="f"'; |
print ' onchange="submit()"' if $use_java_script; |
print ' onchange="this.form.submit()"' if $use_java_script; |
print '>'; |
print ">\n"; |
|
|
local $_; |
local $_; |
for (@DIFFTYPES) { |
for (@DIFFTYPES) { |
printf('<OPTION VALUE="%s"%s>%s', $_, |
printf("<option value=\"%s\"%s>%s</option>\n", $_, |
$f eq $_ ? ' SELECTED' : '', "\u$DIFFTYPES{$_}{'descr'}"); |
$f eq $_ ? ' selected' : '', "\u$DIFFTYPES{$_}{'descr'}"); |
} |
} |
|
|
print "</SELECT>"; |
print "</select>"; |
} |
} |
|
|
sub printLogSortSelect($) { |
sub printLogSortSelect($) { |
my ($use_java_script) = @_; |
my ($use_java_script) = @_; |
|
|
print '<SELECT NAME="logsort"'; |
print '<select id="logsort" name="logsort"'; |
print ' onchange="submit()"' if $use_java_script; |
print ' onchange="this.form.submit()"' if $use_java_script; |
print '>'; |
print ">\n"; |
|
|
local $_; |
local $_; |
for (@LOGSORTKEYS) { |
for (@LOGSORTKEYS) { |
printf('<OPTION VALUE="%s"%s>%s', $_, |
printf("<option value=\"%s\"%s>%s</option>\n", $_, |
$logsort eq $_ ? ' SELECTED' : '', |
$logsort eq $_ ? ' selected' : '', |
"\u$LOGSORTKEYS{$_}{'descr'}"); |
"\u$LOGSORTKEYS{$_}{'descr'}"); |
} |
} |
|
|
print "</SELECT>"; |
print "</select>"; |
} |
} |
|
|
sub findLastModifiedSubdirs(@) { |
sub findLastModifiedSubdirs(@) { |
Line 1201 sub findLastModifiedSubdirs(@) { |
|
Line 1271 sub findLastModifiedSubdirs(@) { |
|
my ($lastmodtime) = undef; |
my ($lastmodtime) = undef; |
my $dh = do { local (*DH); }; |
my $dh = do { local (*DH); }; |
|
|
opendir($dh, $dir) || next; |
opendir($dh, $dir) or next; |
my (@filenames) = readdir($dh); |
my (@filenames) = readdir($dh); |
closedir($dh); |
closedir($dh); |
|
|
Line 1209 sub findLastModifiedSubdirs(@) { |
|
Line 1279 sub findLastModifiedSubdirs(@) { |
|
$filename = "$dirname/$filename"; |
$filename = "$dirname/$filename"; |
my ($file) = "$fullname/$filename"; |
my ($file) = "$fullname/$filename"; |
next if ($filename !~ /,v$/ || !-f $file); |
next if ($filename !~ /,v$/ || !-f $file); |
|
|
|
# Skip forbidden files. |
|
(my $f = $file) =~ s/,v$//; |
|
next if forbidden_file($f); |
|
|
$filename =~ s/,v$//; |
$filename =~ s/,v$//; |
my $modtime = -M $file; |
my $modtime = -M $file; |
|
|
Line 1262 sub htmlify($;$) { |
|
Line 1337 sub htmlify($;$) { |
|
if ($extra) { |
if ($extra) { |
|
|
# get PR #'s as link: "PR#nnnn" "PR: nnnn, ..." "PR nnnn, ..." "bin/nnnn" |
# get PR #'s as link: "PR#nnnn" "PR: nnnn, ..." "PR nnnn, ..." "bin/nnnn" |
if (defined($prcgi) && defined($re_prcategories) |
if (defined($prcgi) && defined($re_prkeyword)) |
&& defined($re_prkeyword)) |
|
{ |
{ |
my $prev; |
my $prev; |
|
|
Line 1286 sub htmlify($;$) { |
|
Line 1360 sub htmlify($;$) { |
|
$_; |
$_; |
} while ($_ ne $prev); |
} while ($_ ne $prev); |
|
|
$_ = htmlify_sub { |
if (defined($re_prcategories)) { |
s{ |
$_ = htmlify_sub { |
(\b$re_prcategories/(\d+)\b) |
s{ |
}{ |
(\b$re_prcategories/(\d+)\b) |
&link($1, sprintf($prcgi, $2)) |
}{ |
}egox; |
&link($1, sprintf($prcgi, $2)) |
} |
}egox; |
$_; |
} |
|
$_; |
|
} |
} |
} |
|
|
# get manpage specs as link: "foo.1" "foo(1)" |
# get manpage specs as link: "foo.1" "foo(1)" |
Line 1342 sub spacedHtmlText($;$) { |
|
Line 1418 sub spacedHtmlText($;$) { |
|
s/ /\001nbsp;/g; |
s/ /\001nbsp;/g; |
} |
} |
|
|
$_ = htmlify($_); |
$_ = htmlify($_, $allow_source_extra); |
|
|
# unescape |
# unescape |
y/\001/&/; |
y/\001/&/; |
|
|
$url =~ s/:/sprintf("%%%02x", ord($&))/eg |
$url =~ s/:/sprintf("%%%02x", ord($&))/eg |
if $url =~ /^[^a-z]/; # relative |
if $url =~ /^[^a-z]/; # relative |
|
|
sprintf '<A HREF="%s">%s</A>', hrefquote($url), $name; |
sprintf '<a href="%s">%s</a>', hrefquote($url), $name; |
} |
} |
|
|
sub revcmp($$) { |
sub revcmp($$) { |
Line 1379 sub revcmp($$) { |
|
Line 1455 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 "Error: $errmsg\n"; |
print "<p>Error: ", |
print &html_footer; |
sprintf($format, map(htmlquote($_), @args)), |
|
"</p>\n"; |
|
html_footer(); |
exit(1); |
exit(1); |
} |
} |
|
|
Line 1402 sub redirect($) { |
|
Line 1480 sub redirect($) { |
|
print "Location: $url\r\n"; |
print "Location: $url\r\n"; |
} |
} |
html_header("Moved"); |
html_header("Moved"); |
print "This document is located ", &link('here', $url), "\n"; |
print "<p>This document is located ", &link('here', $url), "</p>\n"; |
print &html_footer; |
html_footer(); |
exit(1); |
exit(1); |
} |
} |
|
|
Line 1514 sub scan_directives(@) { |
|
Line 1592 sub scan_directives(@) { |
|
('tabstop' => $ts); |
('tabstop' => $ts); |
} |
} |
|
|
|
sub openOutputFilter() { |
|
return if !defined($output_filter) || $output_filter eq ''; |
|
|
|
open(STDOUT, "|-") and return; |
|
|
|
# child of child |
|
open(STDERR, '>/dev/null'); |
|
exec($output_filter) or exit -1; |
|
} |
|
|
############################### |
############################### |
# show Annotation |
# show Annotation |
############################### |
############################### |
Line 1527 sub doAnnotate($$) { |
|
Line 1615 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)) { |
|
&fatal("403 Forbidden", |
|
"Access forbidden. This file is mentioned in \@ForbiddenFiles" |
|
); |
|
return; |
|
} |
|
|
|
($pathname = $where) =~ s/(Attic\/)?[^\/]*$//; |
($pathname = $where) =~ s/(Attic\/)?[^\/]*$//; |
($filename = $where) =~ s/^.*\///; |
($filename = $where) =~ s/^.*\///; |
|
|
Line 1552 sub doAnnotate($$) { |
|
Line 1634 sub doAnnotate($$) { |
|
# 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, $CMD{cvs}, @cvs_options, "server") |
$pid = open2($reader, $writer, $CMD{cvs}, @cvs_options, "server") |
|| 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 1608 sub doAnnotate($$) { |
|
Line 1690 sub doAnnotate($$) { |
|
# OK, we've sent our command to the server. Thing to do is to |
# OK, we've sent our command to the server. Thing to do is to |
# close the writer side and get all the responses. If "cvs server" |
# close the writer side and get all the responses. If "cvs server" |
# were nicer about buffering, then we could just leave it open, I think. |
# were nicer about buffering, then we could just leave it open, I think. |
close($writer) || die "cannot close: $!"; |
close($writer) or die "cannot close: $!"; |
|
|
http_header(); |
http_header(); |
|
|
navigateHeader($scriptwhere, $pathname, $filename, $rev, "annotate"); |
navigateHeader($scriptwhere, $pathname, $filename, $rev, "annotate"); |
print |
print |
"<h3 align=center>Annotation of $pathname$filename, Revision $rev</h3>\n"; |
"<h3 style=\"text-align: center\">Annotation of $pathname$filename, Revision $rev</h3>\n"; |
|
|
# Ready to get the responses from the server. |
# Ready to get the responses from the server. |
# For example: |
# For example: |
Line 1627 sub doAnnotate($$) { |
|
Line 1709 sub doAnnotate($$) { |
|
my ($revprint, $usrprint); |
my ($revprint, $usrprint); |
|
|
if ($annTable) { |
if ($annTable) { |
print "<table border=0 cellspacing=0 cellpadding=0>\n"; |
print "<table style=\"border: none\" cellspacing=\"0\" cellpadding=\"0\">\n"; |
} else { |
} else { |
print "<pre>"; |
print "<pre>"; |
} |
} |
Line 1688 sub doAnnotate($$) { |
|
Line 1770 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 1697 sub doAnnotate($$) { |
|
Line 1780 sub doAnnotate($$) { |
|
} else { |
} else { |
print "</pre>"; |
print "</pre>"; |
} |
} |
close($reader) || warn "cannot close: $!"; |
close($reader) or warn "cannot close: $!"; |
wait; |
wait; |
} |
} |
|
|
Line 1716 sub doCheckout($$) { |
|
Line 1799 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)) { |
|
&fatal("403 Forbidden", |
|
"Access forbidden. This file is mentioned in \@ForbiddenFiles" |
|
); |
|
return; |
|
} |
|
|
|
# get mimetype |
# get mimetype |
if (defined($input{"content-type"}) |
if (defined($input{"content-type"}) |
&& ($input{"content-type"} =~ /\S\/\S/)) |
&& ($input{"content-type"} =~ /\S\/\S/)) |
Line 1761 sub doCheckout($$) { |
|
Line 1838 sub doCheckout($$) { |
|
# chdir to $tmpdir before to avoid non-readable cgi-bin directories |
# chdir to $tmpdir before to avoid non-readable cgi-bin directories |
chdir($tmpdir); |
chdir($tmpdir); |
open(STDERR, ">&STDOUT"); # Redirect stderr to stdout |
open(STDERR, ">&STDOUT"); # Redirect stderr to stdout |
exec($CMD{cvs}, @cvs_options, '-d', $cvsroot, 'co', '-p', |
|
$revopt, $where); |
# work around a bug of cvs -p; expand symlinks |
|
use Cwd 'abs_path'; |
|
exec($CMD{cvs}, @cvs_options, |
|
'-d', abs_path($cvsroot), |
|
'co', '-p', |
|
$revopt, $where) or exit -1; |
} |
} |
|
|
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 1790 sub doCheckout($$) { |
|
Line 1874 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 1815 sub cvswebMarkup($$$) { |
|
Line 1900 sub cvswebMarkup($$$) { |
|
http_header(); |
http_header(); |
|
|
navigateHeader($scriptwhere, $pathname, $filename, $revision, "view"); |
navigateHeader($scriptwhere, $pathname, $filename, $revision, "view"); |
print "<HR noshade>"; |
print "<hr noshade>"; |
print "<table width=\"100%\"><tr><td bgcolor=\"$markupLogColor\">"; |
print "<table width=\"100%\">\n<tr>\n<td style=\"background-color: $markupLogColor\">"; |
print "File: ", &clickablePath($where, 1); |
print "File: ", &clickablePath($where, 1); |
print " ("; |
print " ("; |
&download_link($fileurl, $revision, "download"); |
&download_link($fileurl, $revision, "download"); |
Line 1827 sub cvswebMarkup($$$) { |
|
Line 1912 sub cvswebMarkup($$$) { |
|
&download_link($fileurl, $revision, "as text", "text/plain"); |
&download_link($fileurl, $revision, "as text", "text/plain"); |
print ")"; |
print ")"; |
} |
} |
print "<BR>\n"; |
print "<br>\n"; |
|
|
if ($show_log_in_markup) { |
if ($show_log_in_markup) { |
readLog($fullname); #,$revision); |
readLog($fullname); #,$revision); |
printLog($revision, 0); |
printLog($revision, 0); |
} else { |
} else { |
print "Version: <B>$revision</B><BR>\n"; |
print "Version: <b>$revision</b><br>\n"; |
print "Tag: <B>", $input{only_with_tag}, "</b><br>\n" |
print "Tag: <b>", $input{only_with_tag}, "</b><br>\n" |
if $input{only_with_tag}; |
if $input{only_with_tag}; |
} |
} |
print "</td></tr></table>"; |
print "</td>\n</tr>\n</table>"; |
my $url = download_url($fileurl, $revision, $mimetype); |
my $url = download_url($fileurl, $revision, $mimetype); |
print "<HR noshade>"; |
print "<hr noshade>"; |
|
|
if ($mimetype =~ /^image/) { |
if ($mimetype =~ /^image/) { |
printf '<IMG SRC="%s"><BR>', hrefquote("$url$barequery"); |
printf '<img src="%s" alt=""><br>', hrefquote("$url$barequery"); |
} elsif ($mimetype =~ m%^application/pdf%) { |
} elsif ($mimetype =~ m%^application/pdf%) { |
printf '<EMBED SRC="%s" WIDTH="100%"><BR>', |
printf '<embed src="%s" width="100%"><br>', |
hrefquote("$url$barequery"); |
hrefquote("$url$barequery"); |
} elsif ($preformat_in_markup) { |
} elsif ($preformat_in_markup) { |
print "<PRE>"; |
print "<pre>"; |
|
|
# prefetch several lines |
# prefetch several lines |
my @buf = head($filehandle); |
my @buf = head($filehandle); |
Line 1859 sub cvswebMarkup($$$) { |
|
Line 1944 sub cvswebMarkup($$$) { |
|
|
|
print spacedHtmlText($_, $d{'tabstop'}); |
print spacedHtmlText($_, $d{'tabstop'}); |
} |
} |
print "</PRE>"; |
print "</pre>"; |
} else { |
} else { |
print "<PRE>"; |
print "<pre>"; |
|
|
while (<$filehandle>) { |
while (<$filehandle>) { |
print htmlquote($_); |
print htmlquote($_); |
} |
} |
print "</PRE>"; |
print "</pre>"; |
} |
} |
} |
} |
|
|
Line 1885 sub doDiff($$$$$$) { |
|
Line 1970 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 1912 sub doDiff($$$$$$) { |
|
Line 1996 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 1928 sub doDiff($$$$$$) { |
|
Line 2013 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 1959 sub doDiff($$$$$$) { |
|
Line 2046 sub doDiff($$$$$$) { |
|
|
|
if (!open($fh, "-|")) { # child |
if (!open($fh, "-|")) { # child |
open(STDERR, ">&STDOUT"); # Redirect stderr to stdout |
open(STDERR, ">&STDOUT"); # Redirect stderr to stdout |
exec($CMD{rcsdiff}, @difftype, "-r$rev1", "-r$rev2", $fullname); |
openOutputFilter(); |
|
exec($CMD{rcsdiff}, @difftype, "-r$rev1", "-r$rev2", $fullname) or exit -1; |
} |
} |
if ($human_readable) { |
if ($human_readable) { |
http_header(); |
http_header(); |
&human_readable_diff($fh, $rev2); |
&human_readable_diff($fh, $rev2); |
|
html_footer(); |
gzipclose(); |
gzipclose(); |
exit; |
exit; |
} else { |
} else { |
Line 2045 sub getDirLogs($$@) { |
|
Line 2134 sub getDirLogs($$@) { |
|
if (defined($tag)) { |
if (defined($tag)) { |
|
|
#can't use -r<tag> as - is allowed in tagnames, but misinterpreated by rlog.. |
#can't use -r<tag> as - is allowed in tagnames, but misinterpreated by rlog.. |
if (!open($fh, "-|")) { |
if (!open($fh, "-|")) { # child |
open(STDERR, '>/dev/null'); # rlog may complain; ignore. |
open(STDERR, '>/dev/null'); # rlog may complain; ignore. |
exec($CMD{rlog}, @files); |
openOutputFilter(); |
|
exec($CMD{rlog}, @files) or exit -1; |
} |
} |
} else { |
} else { |
|
|
if (!open($fh, "-|")) { |
if (!open($fh, "-|")) { # child |
open(STDERR, '>/dev/null'); # rlog may complain; ignore. |
open(STDERR, '>/dev/null'); # rlog may complain; ignore. |
exec($CMD{rlog}, '-r', @files); |
openOutputFilter(); |
|
exec($CMD{rlog}, '-r', @files) or exit -1; |
} |
} |
} |
} |
$state = "start"; |
$state = "start"; |
Line 2111 sub getDirLogs($$@) { |
|
Line 2202 sub getDirLogs($$@) { |
|
} |
} |
|
|
if ($state eq "tags") { |
if ($state eq "tags") { |
if (/^\s+(.+):\s+([\d\.]+)\s+$/) { |
if (/^\s+([^:]+):\s+([\d\.]+)\s*$/) { |
push (@filetags, $1); |
push (@filetags, $1); |
$symrev{$1} = $2; |
$symrev{$1} = $2; |
$alltags{$1} = 1; |
$alltags{$1} = 1; |
Line 2203 sub getDirLogs($$@) { |
|
Line 2294 sub getDirLogs($$@) { |
|
$state = "log"; |
$state = "log"; |
$log = ''; |
$log = ''; |
next; |
next; |
} elsif ($rev eq '' && /^revision (.*)$/) { |
} elsif ($rev eq '' && /^revision (\d+(?:\.\d+)+).*$/) { |
$rev = $1; |
$rev = $1; # .*$ eats up the locker(lockers?) info, if any |
next; |
next; |
} else { |
} else { |
$log .= $_; |
$log .= $_; |
Line 2218 sub getDirLogs($$@) { |
|
Line 2309 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 2249 sub readLog($;$) { |
|
Line 2339 sub readLog($;$) { |
|
print("Going to rlog '$fullname'\n") if ($verbose); |
print("Going to rlog '$fullname'\n") if ($verbose); |
if (!open($fh, "-|")) { # child |
if (!open($fh, "-|")) { # child |
if ($revision ne '') { |
if ($revision ne '') { |
exec($CMD{rlog}, $revision, $fullname); |
openOutputFilter(); |
|
exec($CMD{rlog}, $revision, $fullname) or exit -1; |
} else { |
} else { |
exec($CMD{rlog}, $fullname); |
openOutputFilter(); |
|
exec($CMD{rlog}, $fullname) or exit -1; |
} |
} |
} |
} |
|
|
Line 2281 sub readLog($;$) { |
|
Line 2373 sub readLog($;$) { |
|
# date: 1995/11/29 22:15:52; author: fenner; state: Exp; lines: +5 -3 |
# date: 1995/11/29 22:15:52; author: fenner; state: Exp; lines: +5 -3 |
# log info |
# log info |
# ---------------------------- |
# ---------------------------- |
|
|
|
# For a locked revision, the first line after the separator |
|
# becomes smth like |
|
# revision 9.19 locked by: vassilii; |
|
|
logentry: |
logentry: |
|
|
while (!/$LOG_FILESEPARATOR/o) { |
while (!/$LOG_FILESEPARATOR/o) { |
$_ = <$fh>; |
$_ = <$fh>; |
last logentry if (!defined($_)); # EOF |
last logentry if (!defined($_)); # EOF |
print "R:", $_ if ($verbose); |
print "R:", $_ if ($verbose); |
if (/^revision ([\d\.]+)/) { |
if (/^revision (\d+(?:\.\d+)+)/) { |
$rev = $1; |
$rev = $1; |
unshift (@allrevisions, $rev); |
unshift (@allrevisions, $rev); |
} elsif (/$LOG_FILESEPARATOR/o || /$LOG_REVSEPARATOR/o) { |
} elsif (/$LOG_FILESEPARATOR/o || /$LOG_REVSEPARATOR/o) { |
Line 2302 sub readLog($;$) { |
|
Line 2399 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 2323 sub readLog($;$) { |
|
Line 2418 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 2416 sub readLog($;$) { |
|
Line 2512 sub readLog($;$) { |
|
} |
} |
$revsym{$rev} .= ", " if ($revsym{$rev}); |
$revsym{$rev} .= ", " if ($revsym{$rev}); |
$revsym{$rev} .= $_; |
$revsym{$rev} .= $_; |
$sel .= "<OPTION VALUE=\"${rev}:${_}\">$_\n"; |
$sel .= "<option value=\"${rev}:${_}\">$_</option>\n"; |
} |
} |
print "Done associating revisions with branches\n" if ($verbose); |
print "Done associating revisions with branches\n" if ($verbose); |
|
|
Line 2431 sub readLog($;$) { |
|
Line 2527 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'}); |
} |
} |
} |
} |
|
|
Line 2490 sub printLog($;$) { |
|
Line 2587 sub printLog($;$) { |
|
$link = 1 if (!defined($link)); |
$link = 1 if (!defined($link)); |
$isDead = ($state{$_} eq "dead"); |
$isDead = ($state{$_} eq "dead"); |
|
|
|
print "<p>\n"; |
if ($link && !$isDead) { |
if ($link && !$isDead) { |
my ($filename); |
my ($filename); |
($filename = $where) =~ s/^.*\///; |
($filename = $where) =~ s/^.*\///; |
my ($fileurl) = urlencode($filename); |
my ($fileurl) = urlencode($filename); |
print "<a NAME=\"rev$_\"></a>"; |
print "<a name=\"rev$_\"></a>"; |
|
|
if (defined($revsym{$_})) { |
if (defined($revsym{$_})) { |
foreach my $sym (split (", ", $revsym{$_})) { |
foreach my $sym (split (", ", $revsym{$_})) { |
print "<a NAME=\"$sym\"></a>"; |
print "<a name=\"$sym\"></a>"; |
} |
} |
} |
} |
|
|
Line 2506 sub printLog($;$) { |
|
Line 2604 sub printLog($;$) { |
|
&& !defined($nameprinted{$br})) |
&& !defined($nameprinted{$br})) |
{ |
{ |
foreach my $sym (split (", ", $revsym{$br})) { |
foreach my $sym (split (", ", $revsym{$br})) { |
print "<a NAME=\"$sym\"></a>"; |
print "<a name=\"$sym\"></a>"; |
} |
} |
$nameprinted{$br} = 1; |
$nameprinted{$br} = 1; |
} |
} |
Line 2561 sub printLog($;$) { |
|
Line 2659 sub printLog($;$) { |
|
} |
} |
} |
} |
} else { |
} else { |
print "Revision <B>$_</B>"; |
print "Revision <b>$_</b>"; |
} |
} |
|
|
if (/^1\.1\.1\.\d+$/) { |
if (/^1\.1\.1\.\d+$/) { |
Line 2576 sub printLog($;$) { |
|
Line 2674 sub printLog($;$) { |
|
print readableTime(time() - $date{$_}, 1), " ago)"; |
print readableTime(time() - $date{$_}, 1), " ago)"; |
print " by "; |
print " by "; |
print "<i>", $author{$_}, "</i>\n"; |
print "<i>", $author{$_}, "</i>\n"; |
print "<BR>Branch: <b>", $link ? link_tags($revsym{$br}) : $revsym{$br}, |
print "<br>Branch: <b>", $link ? link_tags($revsym{$br}) : $revsym{$br}, |
"</b>\n" |
"</b>\n" |
if ($revsym{$br}); |
if ($revsym{$br}); |
print "<BR>CVS Tags: <b>", $link ? link_tags($revsym{$_}) : $revsym{$_}, |
print "<br>CVS Tags: <b>", $link ? link_tags($revsym{$_}) : $revsym{$_}, |
"</b>" |
"</b>" |
if ($revsym{$_}); |
if ($revsym{$_}); |
print "<BR>Branch point for: <b>", |
print "<br>Branch point for: <b>", |
$link ? link_tags($branchpoint{$_}) : $branchpoint{$_}, "</b>\n" |
$link ? link_tags($branchpoint{$_}) : $branchpoint{$_}, "</b>\n" |
if ($branchpoint{$_}); |
if ($branchpoint{$_}); |
|
|
Line 2601 sub printLog($;$) { |
|
Line 2699 sub printLog($;$) { |
|
if ($prev ne "") { |
if ($prev ne "") { |
if ($difflines{$_}) { |
if ($difflines{$_}) { |
print |
print |
"<BR>Changes since <b>$prev: $difflines{$_} lines</b>"; |
"<br>Changes since <b>$prev: $difflines{$_} lines</b>"; |
} |
} |
} |
} |
|
|
if ($isDead) { |
if ($isDead) { |
print "<BR><B><I>FILE REMOVED</I></B>\n"; |
print "<br><b><i>FILE REMOVED</i></b>\n"; |
} elsif ($link) { |
} elsif ($link) { |
my %diffrev = (); |
my %diffrev = (); |
$diffrev{$_} = 1; |
$diffrev{$_} = 1; |
$diffrev{""} = 1; |
$diffrev{""} = 1; |
print "<BR>Diff"; |
print '<br>'; |
|
my $diff = 'Diff'; |
|
|
# |
# |
# Offer diff to previous revision |
# Offer diff to previous revision |
Line 2622 sub printLog($;$) { |
|
Line 2721 sub printLog($;$) { |
|
sprintf('%s.diff?r1=%s&r2=%s%s', $scriptwhere, |
sprintf('%s.diff?r1=%s&r2=%s%s', $scriptwhere, |
$prev, $_, $barequery); |
$prev, $_, $barequery); |
|
|
print " to previous "; |
print $diff, " to previous "; |
|
$diff = ''; |
printDiffLinks($prev, $url); |
printDiffLinks($prev, $url); |
} |
} |
|
|
Line 2636 sub printLog($;$) { |
|
Line 2736 sub printLog($;$) { |
|
sprintf('%s.diff?r1=%s&r2=%s%s', $scriptwhere, $brp, |
sprintf('%s.diff?r1=%s&r2=%s%s', $scriptwhere, $brp, |
$_, $barequery); |
$_, $barequery); |
|
|
print " to branchpoint "; |
print $diff, " to branchpoint "; |
|
$diff = ''; |
printDiffLinks($brp, $url); |
printDiffLinks($brp, $url); |
} |
} |
|
|
Line 2678 sub printLog($;$) { |
|
Line 2779 sub printLog($;$) { |
|
$scriptwhere, $nextmain, $_, |
$scriptwhere, $nextmain, $_, |
$barequery); |
$barequery); |
|
|
print " next main "; |
print $diff, " next main "; |
|
$diff = ''; |
printDiffLinks($nextmain, $url); |
printDiffLinks($nextmain, $url); |
} |
} |
} |
} |
Line 2692 sub printLog($;$) { |
|
Line 2794 sub printLog($;$) { |
|
sprintf('%s.diff?r1=%s&r2=%s%s', $scriptwhere, |
sprintf('%s.diff?r1=%s&r2=%s%s', $scriptwhere, |
$input{'r1'}, $_, $barequery); |
$input{'r1'}, $_, $barequery); |
|
|
print " to selected "; |
print $diff, " to selected "; |
|
$diff = ''; |
printDiffLinks($input{'r1'}, $url); |
printDiffLinks($input{'r1'}, $url); |
} |
} |
|
|
} |
} |
print "<PRE>\n"; |
print "\n</p>\n<pre>\n"; |
print &htmlify($log{$_}, 1); |
print &htmlify($log{$_}, $allow_log_extra); |
print "</PRE>\n"; |
print "</pre>\n"; |
} |
} |
|
|
sub doLog($) { |
sub doLog($) { |
|
|
($upwhere = $where) =~ s|(Attic/)?[^/]+$||; |
($upwhere = $where) =~ s|(Attic/)?[^/]+$||; |
($filename = $where) =~ s|^.*/||; |
($filename = $where) =~ s|^.*/||; |
$backurl = $scriptname . "/" . urlencode($upwhere) . $query; |
$backurl = $scriptname . "/" . urlencode($upwhere) . $query; |
|
print "<p>\n "; |
print &link($backicon, "$backurl#$filename"), " <b>Up to ", |
print &link($backicon, "$backurl#$filename"), " <b>Up to ", |
&clickablePath($upwhere, 1), "</b><p>\n"; |
&clickablePath($upwhere, 1), "</b>\n</p>\n"; |
|
print "<p>\n "; |
print &link('Request diff between arbitrary revisions', '#diff'); |
print &link('Request diff between arbitrary revisions', '#diff'); |
print '<HR NOSHADE>'; |
print "\n</p>\n<hr noshade>\n"; |
|
|
|
print "<p>\n"; |
if ($curbranch) { |
if ($curbranch) { |
print "Default branch: ", ($revsym{$curbranch} || $curbranch); |
print "Default branch: ", ($revsym{$curbranch} || $curbranch); |
} else { |
} else { |
print "No default branch"; |
print "No default branch"; |
} |
} |
print "<BR>\n"; |
print "<br>\n"; |
|
|
if ($input{only_with_tag}) { |
if ($input{only_with_tag}) { |
print "Current tag: $input{only_with_tag}<BR>\n"; |
print "Current tag: $input{only_with_tag}<br>\n"; |
} |
} |
|
print "</p>\n"; |
|
|
undef %nameprinted; |
undef %nameprinted; |
|
|
for (my $i = 0 ; $i <= $#revdisplayorder ; $i++) { |
for (my $i = 0 ; $i <= $#revdisplayorder ; $i++) { |
print "<HR size=1 NOSHADE>"; |
print "<hr size=\"1\" noshade>\n"; |
printLog($revdisplayorder[$i]); |
printLog($revdisplayorder[$i]); |
} |
} |
|
|
print "<HR NOSHADE>"; |
print "<hr noshade>\n<p>\n"; |
print "<A NAME=diff>\n"; |
print "<a name=\"diff\">\n"; |
print "This form allows you to request diff's between any two\n"; |
print "This form allows you to request diff's between any two\n"; |
print "revisions of a file. You may select a symbolic revision\n"; |
print "revisions of a file. You may select a symbolic revision\n"; |
print "name using the selection box or you may type in a numeric\n"; |
print "name using the selection box or you may type in a numeric\n"; |
print "name using the type-in text box.\n"; |
print "name using the type-in text box.\n"; |
print "</A><P>\n"; |
print "</a>\n</p>\n"; |
print |
print |
"<FORM METHOD=\"GET\" ACTION=\"${scriptwhere}.diff\" NAME=\"diff_select\">\n"; |
"<form method=\"get\" action=\"${scriptwhere}.diff\" name=\"diff_select\">\n"; |
|
|
foreach (@stickyvars) { |
foreach (@stickyvars) { |
printf('<INPUT TYPE=HIDDEN NAME="%s" VALUE="%s">', $_, |
printf('<input type="hidden" name="%s" value="%s">', $_, |
$input{$_}) |
$input{$_}) |
if (defined($input{$_}) |
if (defined($input{$_}) |
&& ((!defined($DEFAULTVALUE{$_}) |
&& ((!defined($DEFAULTVALUE{$_}) |
|| $input{$_} ne $DEFAULTVALUE{$_}) && $input{$_} ne "")); |
|| $input{$_} ne $DEFAULTVALUE{$_}) && $input{$_} ne "")); |
} |
} |
print "<TABLE><TR>\n"; |
print "<table style=\"border: none\">\n<tr>\n"; |
print "<TD align=right>Diffs between \n"; |
print "<td align=\"right\">"; |
print "<SELECT NAME=\"r1\">\n"; |
print "<label for=\"r1\" accesskey=\"1\">Diffs between </label>\n"; |
print "<OPTION VALUE=\"text\" SELECTED>Use Text Field\n"; |
print "<select id=\"r1\" name=\"r1\">\n"; |
|
print "<option value=\"text\" selected>Use Text Field</option>\n"; |
print $sel; |
print $sel; |
print "</SELECT>\n"; |
print "</select>\n"; |
$diffrev = $revdisplayorder[$#revdisplayorder]; |
$diffrev = $revdisplayorder[$#revdisplayorder]; |
$diffrev = $input{"r1"} if (defined($input{"r1"})); |
$diffrev = $input{"r1"} if (defined($input{"r1"})); |
print |
print |
"<INPUT TYPE=\"TEXT\" SIZE=\"$inputTextSize\" NAME=\"tr1\" VALUE=\"$diffrev\" onChange='document.diff_select.r1.selectedIndex=0'></TD>"; |
"<input type=\"text\" size=\"$inputTextSize\" name=\"tr1\" value=\"$diffrev\" onchange=\"this.form.r1.selectedIndex=0\"></td>\n"; |
print "<TD><BR></TD></TR>\n"; |
print "<td><br></td>\n</tr>\n"; |
print "<TR><TD align=right>and \n"; |
print "<tr>\n<td align=\"right\">"; |
print "<SELECT NAME=\"r2\">\n"; |
print "<label for=\"r2\" accesskey=\"2\">and </label>\n"; |
print "<OPTION VALUE=\"text\" SELECTED>Use Text Field\n"; |
print "<select id=\"r2\" name=\"r2\">\n"; |
|
print "<option value=\"text\" selected>Use Text Field</option>\n"; |
print $sel; |
print $sel; |
print "</SELECT>\n"; |
print "</select>\n"; |
$diffrev = $revdisplayorder[0]; |
$diffrev = $revdisplayorder[0]; |
$diffrev = $input{"r2"} if (defined($input{"r2"})); |
$diffrev = $input{"r2"} if (defined($input{"r2"})); |
print |
print |
"<INPUT TYPE=\"TEXT\" SIZE=\"$inputTextSize\" NAME=\"tr2\" VALUE=\"$diffrev\" onChange='document.diff_select.r2.selectedIndex=0'></TD>"; |
"<input type=\"text\" size=\"$inputTextSize\" name=\"tr2\" value=\"$diffrev\" onchange=\"this.form.r2.selectedIndex=0\"></td>\n"; |
print "<TD><INPUT TYPE=SUBMIT VALUE=\" Get Diffs \"></TD>\n"; |
print "<td><input type=\"submit\" value=\" Get Diffs \" accesskey=\"G\"></td>\n"; |
print "</FORM>\n"; |
print "</tr>\n</table>\n"; |
print "</TR></TABLE>\n"; |
print "</form>\n"; |
print "<HR noshade>\n"; |
print "<hr noshade>\n"; |
print "<TABLE>"; |
print "<form method=\"get\" action=\"$scriptwhere\">\n"; |
print "<FORM METHOD=\"GET\" ACTION=\"$scriptwhere\">\n"; |
print "<table style=\"border: none\">\n"; |
print "<TR><TD align=right>Preferred Diff type:</TD>"; |
print "<tr>\n<td align=\"right\">"; |
print "<TD>"; |
print "<label for=\"f\" accesskey=\"D\">Preferred Diff type:"; |
|
print "</label></td>\n"; |
|
print "<td>"; |
printDiffSelect($use_java_script); |
printDiffSelect($use_java_script); |
print "</TD><TD></TD></TR>\n"; |
print "</td>\n<td></td>\n</tr>\n"; |
|
|
if (@branchnames) { |
if (@branchnames) { |
print "<TR><TD align=right>View only Branch:</TD>"; |
print "<tr>\n<td align=\"right\">"; |
print "<TD>"; |
print "<label for=\"only_with_tag\" accesskey=\"B\">"; |
print "<A name=branch></A>\n"; |
print "View only Branch:</label></td>\n"; |
print "<SELECT NAME=\"only_with_tag\""; |
print "<td>"; |
print " onchange=\"submit()\"" if ($use_java_script); |
print "<a name=\"branch\"></a>\n"; |
|
print "<select id=\"only_with_tag\" name=\"only_with_tag\""; |
|
print " onchange=\"this.form.submit()\"" if $use_java_script; |
print ">\n"; |
print ">\n"; |
print "<OPTION VALUE=\"\""; |
print "<option value=\"\""; |
print " SELECTED" |
print " selected" |
if (defined($input{"only_with_tag"}) |
if (defined($input{"only_with_tag"}) |
&& $input{"only_with_tag"} eq ""); |
&& $input{"only_with_tag"} eq ""); |
print ">Show all branches\n"; |
print ">Show all branches</option>\n"; |
|
|
foreach (reverse sort @branchnames) { |
foreach (reverse sort @branchnames) { |
print "<OPTION"; |
print "<option"; |
print " SELECTED" |
print " selected" |
if (defined($input{"only_with_tag"}) |
if (defined($input{"only_with_tag"}) |
&& $input{"only_with_tag"} eq $_); |
&& $input{"only_with_tag"} eq $_); |
print ">${_}\n"; |
print ">${_}</option>\n"; |
} |
} |
print "</SELECT></TD><TD></TD></TR>\n"; |
print "</select></td>\n<td></td>\n</tr>\n"; |
} |
} |
|
|
foreach (@stickyvars) { |
foreach (@stickyvars) { |
next if ($_ eq "f"); |
next if ($_ eq "f"); |
next if ($_ eq "only_with_tag"); |
next if ($_ eq "only_with_tag"); |
next if ($_ eq "logsort"); |
next if ($_ eq "logsort"); |
print "<INPUT TYPE=HIDDEN NAME=\"$_\" VALUE=\"$input{$_}\">\n" |
print "<input type=\"hidden\" name=\"$_\" value=\"$input{$_}\">\n" |
if (defined($input{$_}) |
if (defined($input{$_}) |
&& (!defined($DEFAULTVALUE{$_}) |
&& (!defined($DEFAULTVALUE{$_}) |
|| $input{$_} ne $DEFAULTVALUE{$_}) && $input{$_} ne ""); |
|| $input{$_} ne $DEFAULTVALUE{$_}) && $input{$_} ne ""); |
} |
} |
print "<TR><TD align=right>"; |
print "<tr>\n<td align=\"right\">"; |
print "<A name=logsort></A>\n"; |
print "<a name=\"logsort\"></a>\n"; |
print "Sort log by:</TD>"; |
print "<label for=\"logsort\" accesskey=\"L\">Sort log by:"; |
print "<TD>"; |
print "</label></td>\n<td>"; |
printLogSortSelect($use_java_script); |
printLogSortSelect($use_java_script); |
print "</TD>"; |
print "</td>\n"; |
print "<TD><INPUT TYPE=SUBMIT VALUE=\" Set \"></TD>"; |
print "<td><input type=\"submit\" value=\" Set \" accesskey=\"S\"></td>\n"; |
print "</FORM>\n"; |
print "</tr>\n</table>\n"; |
print "</TR></TABLE>"; |
print "</form>\n"; |
print &html_footer; |
html_footer(); |
print "</BODY></HTML>\n"; |
|
} |
} |
|
|
sub flush_diff_rows($$$$) { |
sub flush_diff_rows($$$$) { |
Line 2838 sub flush_diff_rows($$$$) { |
|
Line 2951 sub flush_diff_rows($$$$) { |
|
if ($state eq "PreChangeRemove") { # we just got remove-lines before |
if ($state eq "PreChangeRemove") { # we just got remove-lines before |
for ($j = 0 ; $j < $leftRow ; $j++) { |
for ($j = 0 ; $j < $leftRow ; $j++) { |
print |
print |
"<tr><td bgcolor=\"$diffcolorRemove\">@$leftColRef[$j]</td>"; |
"<tr>\n<td class=\"diff-removed\"> @$leftColRef[$j]</td>\n"; |
print |
print |
"<td bgcolor=\"$diffcolorEmpty\"> </td></tr>\n"; |
"<td class=\"diff-empty\"> </td>\n</tr>\n"; |
} |
} |
} elsif ($state eq "PreChange") { # state eq "PreChange" |
} elsif ($state eq "PreChange") { # state eq "PreChange" |
# we got removes with subsequent adds |
# we got removes with subsequent adds |
|
|
for ($j = 0 ; $j < $leftRow || $j < $rightRow ; $j++) |
for ($j = 0 ; $j < $leftRow || $j < $rightRow ; $j++) |
{ # dump out both cols |
{ # dump out both cols |
print "<tr>"; |
print "<tr>\n"; |
if ($j < $leftRow) { |
if ($j < $leftRow) { |
print |
print |
"<td bgcolor=\"$diffcolorChange\">@$leftColRef[$j]</td>"; |
"<td class=\"diff-changed\"> @$leftColRef[$j]</td>"; |
} else { |
} else { |
print |
print |
"<td bgcolor=\"$diffcolorDarkChange\"> </td>"; |
"<td class=\"diff-changed-missing\"> </td>"; |
} |
} |
|
print "\n"; |
|
|
if ($j < $rightRow) { |
if ($j < $rightRow) { |
print |
print |
"<td bgcolor=\"$diffcolorChange\">@$rightColRef[$j]</td>"; |
"<td class=\"diff-changed\"> @$rightColRef[$j]</td>"; |
} else { |
} else { |
print |
print |
"<td bgcolor=\"$diffcolorDarkChange\"> </td>"; |
"<td class=\"diff-changed-missing\"> </td>"; |
} |
} |
print "</tr>\n"; |
print "\n</tr>\n"; |
} |
} |
} |
} |
} |
} |
Line 2902 sub human_readable_diff($) { |
|
Line 3016 sub human_readable_diff($) { |
|
} |
} |
|
|
print |
print |
"<h3 align=center>Diff for /$where_nd between version $rev1 and $rev2</h3>\n", |
"<h3 style=\"text-align: center\">Diff for /$where_nd between version $rev1 and $rev2</h3>\n", |
"<table border=0 cellspacing=0 cellpadding=0 width=\"100%\">\n", |
# Using style=\"border: none\" here breaks NS 4.x badly... |
"<tr bgcolor=\"#ffffff\">\n", "<th width=\"50%\" valign=TOP>", |
"<table border=\"0\" cellspacing=\"0\" cellpadding=\"0\" width=\"100%\">\n", |
|
"<tr style=\"background-color: #ffffff\">\n", "<th width=\"50%\" valign=\"top\">", |
"version $rev1"; |
"version $rev1"; |
print ", $date1" if (defined($date1)); |
print ", $date1" if (defined($date1)); |
print "<br>Tag: $sym1\n" if ($sym1); |
print "<br>Tag: $sym1\n" if ($sym1); |
print "</th>\n", "<th width=\"50%\" valign=TOP>", "version $rev2"; |
print "</th>\n", "<th width=\"50%\" valign=\"top\">", "version $rev2"; |
print ", $date2" if (defined($date2)); |
print ", $date2" if (defined($date2)); |
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\"><tt>"; |
|
my $fe = "</tt></font>"; |
|
|
|
my $leftRow = 0; |
my $leftRow = 0; |
my $rightRow = 0; |
my $rightRow = 0; |
my ($oldline, $newline, $funname, $diffcode, $rest); |
my ($oldline, $newline, $funname, $diffcode, $rest); |
|
|
# Process diff text |
# Process diff text |
# The diffrows are could make excellent use of |
|
# cascading style sheets because we've to set the |
|
# font and color for each row. anyone ...? |
|
#### |
|
|
|
# prefetch several lines |
# prefetch several lines |
my @buf = head($fh); |
my @buf = head($fh); |
Line 2938 sub human_readable_diff($) { |
|
Line 3046 sub human_readable_diff($) { |
|
($oldline, $newline, $funname) = |
($oldline, $newline, $funname) = |
$difftxt =~ /@@ \-([0-9]+).*\+([0-9]+).*@@(.*)/; |
$difftxt =~ /@@ \-([0-9]+).*\+([0-9]+).*@@(.*)/; |
$funname = htmlquote($funname); |
$funname = htmlquote($funname); |
|
$funname =~ s/\s/ /go; |
print |
print |
"<tr bgcolor=\"$diffcolorHeading\"><td width=\"50%\">"; |
"<tr class=\"diff-heading\">\n<td width=\"50%\">"; |
print |
print |
"<table width=\"100%\" border=1 cellpadding=5><tr><td><b>Line $oldline</b>"; |
"<table width=\"100%\" border=\"1\" cellpadding=\"5\">\n<tr>\n<td><b>Line $oldline</b>"; |
print |
print |
" <font size=-1>$funname</font></td></tr></table>"; |
" <span style=\"font-size: smaller\">$funname</span></td>\n</tr>\n</table>"; |
print "</td><td width=\"50%\">"; |
print "</td>\n<td width=\"50%\">"; |
print |
print |
"<table width=\"100%\" border=1 cellpadding=5><tr><td><b>Line $newline</b>"; |
"<table width=\"100%\" border=\"1\" cellpadding=\"5\">\n<tr>\n<td><b>Line $newline</b>"; |
print |
print |
" <font size=-1>$funname</font></td></tr></table>"; |
" <span style=\"font-size: smaller\">$funname</span></td>\n</tr>\n</table>\n"; |
print "</td>\n"; |
print "</td>\n"; |
$state = "dump"; |
$state = "dump"; |
$leftRow = 0; |
$leftRow = 0; |
Line 2957 sub human_readable_diff($) { |
|
Line 3066 sub human_readable_diff($) { |
|
($diffcode, $rest) = $difftxt =~ /^([-+ ])(.*)/; |
($diffcode, $rest) = $difftxt =~ /^([-+ ])(.*)/; |
$_ = spacedHtmlText($rest, $d{'tabstop'}); |
$_ = spacedHtmlText($rest, $d{'tabstop'}); |
|
|
# Add fontface, size |
|
$_ = "$fs $_$fe"; |
|
|
|
######### |
######### |
# little state machine to parse unified-diff output (Hen, zeller@think.de) |
# little state machine to parse unified-diff output (Hen, zeller@think.de) |
# in order to get some nice 'ediff'-mode output |
# in order to get some nice 'ediff'-mode output |
Line 2973 sub human_readable_diff($) { |
|
Line 3079 sub human_readable_diff($) { |
|
if ($state eq "dump") |
if ($state eq "dump") |
{ # 'change' never begins with '+': just dump out value |
{ # 'change' never begins with '+': just dump out value |
print |
print |
"<tr><td bgcolor=\"$diffcolorEmpty\"> </td><td bgcolor=\"$diffcolorAdd\">$_</td></tr>\n"; |
"<tr>\n<td class=\"diff-empty\"> </td>\n<td class=\"diff-added\"> $_</td>\n</tr>\n"; |
} else { # we got minus before |
} else { # we got minus before |
$state = "PreChange"; |
$state = "PreChange"; |
$rightCol[$rightRow++] = $_; |
$rightCol[$rightRow++] = $_; |
Line 2984 sub human_readable_diff($) { |
|
Line 3090 sub human_readable_diff($) { |
|
} else { # empty diffcode |
} else { # empty diffcode |
flush_diff_rows \@leftCol, \@rightCol, $leftRow, |
flush_diff_rows \@leftCol, \@rightCol, $leftRow, |
$rightRow; |
$rightRow; |
print "<tr><td>$_</td><td>$_</td></tr>\n"; |
print "<tr>\n<td class=\"diff-same\"> $_</td>\n<td class=\"diff-same\"> $_</td>\n</tr>\n"; |
$state = "dump"; |
$state = "dump"; |
$leftRow = 0; |
$leftRow = 0; |
$rightRow = 0; |
$rightRow = 0; |
} |
} |
} |
} |
} |
} |
|
close($fh); |
|
|
flush_diff_rows \@leftCol, \@rightCol, $leftRow, $rightRow; |
flush_diff_rows \@leftCol, \@rightCol, $leftRow, $rightRow; |
|
|
# state is empty if we didn't have any change |
# state is empty if we didn't have any change |
if (!$state) { |
if (!$state) { |
print "<tr><td colspan=2> </td></tr>"; |
print "<tr>\n<td colspan=\"2\"> </td>\n</tr>\n"; |
print "<tr bgcolor=\"$diffcolorEmpty\" >"; |
print "<tr class=\"diff-empty\">\n"; |
print |
print |
"<td colspan=2 align=center><b>- No viewable Change -</b></td></tr>"; |
"<td colspan=\"2\" align=\"center\"><b>- No viewable change -</b></td>\n</tr>\n"; |
} |
} |
print "</table>"; |
print "</table>\n"; |
close($fh); |
|
|
|
print "<br><hr noshade width=\"100%\">\n"; |
print "<hr style=\"width: 100%\" noshade>\n"; |
|
print "<form method=\"get\" action=\"${scriptwhere}\">\n"; |
|
print "<table style=\"border: none\">\n<tr>\n<td>\n"; |
|
|
print "<table border=0>"; |
|
|
|
print "<tr><td>"; |
|
|
|
# print legend |
# print legend |
print "<table border=1><tr><td>"; |
print "<table border=\"1\">\n<tr>\n<td>"; |
print "Legend:<br><table border=0 cellspacing=0 cellpadding=1>\n"; |
print "Legend:<br><table style=\"border: none\" cellspacing=\"0\" cellpadding=\"1\">\n"; |
print |
print |
"<tr><td align=center bgcolor=\"$diffcolorRemove\">Removed from v.$rev1</td><td bgcolor=\"$diffcolorEmpty\"> </td></tr>"; |
"<tr>\n<td align=\"center\" class=\"diff-removed\">Removed from v.$rev1</td>\n<td class=\"diff-empty\"> </td>\n</tr>\n"; |
print |
print |
"<tr bgcolor=\"$diffcolorChange\"><td align=center colspan=2>changed lines</td></tr>"; |
"<tr class=\"diff-changed\">\n<td align=\"center\" colspan=\"2\">changed lines</td>\n</tr>\n"; |
print |
print |
"<tr><td bgcolor=\"$diffcolorEmpty\"> </td><td align=center bgcolor=\"$diffcolorAdd\">Added in v.$rev2</td></tr>"; |
"<tr>\n<td class=\"diff-empty\"> </td>\n<td align=\"center\" class=\"diff-added\">Added in v.$rev2</td>\n</tr>\n"; |
print "</table></td></tr></table>\n"; |
print "</table>\n</td>\n</tr>\n</table>\n</td>\n<td>"; |
|
|
print "<td>"; |
|
|
|
# Print format selector |
# Print format selector |
print "<FORM METHOD=\"GET\" ACTION=\"${scriptwhere}\">\n"; |
|
foreach my $var (keys %input) { |
foreach my $var (keys %input) { |
next if ($var eq "f"); |
next if ($var eq "f"); |
next |
next |
if (defined($DEFAULTVALUE{$var}) |
if (defined($DEFAULTVALUE{$var}) |
&& $DEFAULTVALUE{$var} eq $input{$var}); |
&& $DEFAULTVALUE{$var} eq $input{$var}); |
print "<INPUT TYPE=HIDDEN NAME=\"", urlencode($var), |
print "<input type=\"hidden\" name=\"", urlencode($var), |
"\" VALUE=\"", urlencode($input{$var}), "\">\n"; |
"\" value=\"", urlencode($input{$var}), "\">\n"; |
} |
} |
printDiffSelect($use_java_script); |
printDiffSelect($use_java_script); |
print "<INPUT TYPE=SUBMIT VALUE=\"Show\">\n"; |
print "<input type=\"submit\" value=\"Show\">\n"; |
print "</FORM>\n"; |
print "</td>\n"; |
print "</td>"; |
|
|
|
print "</tr></table>"; |
print "</tr>\n</table>\n"; |
|
print "</form>\n"; |
} |
} |
|
|
sub navigateHeader($$$$$) { |
sub navigateHeader($$$$$) { |
Line 3045 sub navigateHeader($$$$$) { |
|
Line 3147 sub navigateHeader($$$$$) { |
|
$swhere = "" if ($swhere eq $scriptwhere); |
$swhere = "" if ($swhere eq $scriptwhere); |
$swhere = './' . urlencode($filename) if ($swhere eq ""); |
$swhere = './' . urlencode($filename) if ($swhere eq ""); |
|
|
|
# TODO: this should be moved into external CSS file. |
|
my $css = ''; |
|
if ($title eq 'diff') { |
|
$css = " |
|
<style type=\"text/css\"> |
|
.diff-heading { |
|
background-color: $diffcolorHeading; |
|
} |
|
.diff-same { |
|
font-family: $difffontface; |
|
font-size: smaller; |
|
} |
|
.diff-empty { |
|
background-color: $diffcolorEmpty; |
|
} |
|
.diff-added { |
|
background-color: $diffcolorAdd; |
|
font-family: $difffontface; |
|
font-size: smaller; |
|
} |
|
.diff-removed { |
|
background-color: $diffcolorRemove; |
|
font-family: $difffontface; |
|
font-size: smaller; |
|
} |
|
.diff-changed { |
|
background-color: $diffcolorChange; |
|
font-family: $difffontface; |
|
font-size: smaller; |
|
} |
|
.diff-changed-missing { |
|
background-color: $diffcolorDarkChange; |
|
} |
|
</style>"; |
|
} |
|
|
print <<EOF; |
print <<EOF; |
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN"> |
$HTML_DOCTYPE |
<HTML> |
<html> |
<HEAD> |
<head> |
<META name="robots" content="nofollow"> |
<title>$path$filename - $title - $rev</title>$css |
<!-- knu-cvsweb $cvsweb_revision --> |
$HTML_META</head> |
<TITLE>$path$filename - $title - $rev</TITLE></HEAD> |
|
$body_tag_for_src |
$body_tag_for_src |
<table width="100%" border=0 cellspacing=0 cellpadding=1 bgcolor="$navigationHeaderColor"> |
<table width="100%" style="border: none; background-color: $navigationHeaderColor" cellspacing="0" cellpadding="1"> |
<tr valign=bottom><td> |
<tr valign="bottom"><td> |
EOF |
EOF |
|
|
print &link($backicon, "$swhere$query#rev$rev"); |
print &link($backicon, "$swhere$query#rev$rev"); |
|
|
" CVS log"; |
" CVS log"; |
print "</b> $fileicon</td>"; |
print "</b> $fileicon</td>"; |
|
|
print "<td align=right>$diricon <b>Up to ", &clickablePath($path, 1), |
print "<td align=\"right\">$diricon <b>Up to ", |
|
&clickablePath($path, 1), |
"</b></td>"; |
"</b></td>"; |
print "</tr></table>"; |
print "</tr></table>"; |
} |
} |
Line 3167 sub clickablePath($$) { |
|
Line 3305 sub clickablePath($$) { |
|
} |
} |
|
|
sub chooseCVSRoot() { |
sub chooseCVSRoot() { |
|
|
|
print "<form method=\"get\" action=\"${scriptwhere}\">\n"; |
if (2 <= @CVSROOT) { |
if (2 <= @CVSROOT) { |
my ($k); |
my ($k); |
print "<form method=\"GET\" action=\"${scriptwhere}\">\n"; |
|
foreach $k (keys %input) { |
foreach $k (keys %input) { |
print "<input type=hidden NAME=$k VALUE=$input{$k}>\n" |
print "<input type=\"hidden\" name=\"$k\" value=\"$input{$k}\">\n" |
if ($input{$k}) && ($k ne "cvsroot"); |
if ($input{$k}) && ($k ne "cvsroot"); |
} |
} |
|
|
# Form-Elements look wierd in Netscape if the background |
# Form-Elements look wierd in Netscape if the background |
# isn't gray and the form elements are not placed |
# isn't gray and the form elements are not placed |
# within a table ... |
# within a table ... |
print "<table><tr>"; |
print "<table style=\"border: none\">\n<tr>\n"; |
print "<td>CVS Root:</td>"; |
print "<td><label for=\"cvsroot\" accesskey=\"C\">CVS Root:</label></td>\n"; |
print "<td>\n<select name=\"cvsroot\""; |
print "<td>\n<select id=\"cvsroot\" name=\"cvsroot\""; |
print " onchange=\"submit()\"" if ($use_java_script); |
print " onchange=\"this.form.submit()\"" if $use_java_script; |
print ">\n"; |
print ">\n"; |
|
|
foreach $k (@CVSROOT) { |
foreach $k (@CVSROOT) { |
print "<option value=\"$k\""; |
print "<option value=\"$k\""; |
print " selected" if ($k eq $cvstree); |
print " selected" if ($k eq $cvstree); |
print ">", ($CVSROOTdescr{$k} ? $CVSROOTdescr{$k} : $k), |
print ">",($CVSROOTdescr{$k} ? $CVSROOTdescr{$k} : $k), |
"</option>\n"; |
"</option>\n"; |
} |
} |
print "</select>\n</td>"; |
print "</select>\n</td>\n<td>"; |
print "<td>"; |
|
} else { |
} else { |
|
|
# no choice -- but we need the form to select module/path, at least for Netscape |
# no choice -- but we need the form to select module/path, |
print "<form method=\"GET\" action=\"${scriptwhere}\">\n"; |
# at least for Netscape |
|
print "<p>\n"; |
print "CVS Root: <b>[$cvstree]</b>"; |
print "CVS Root: <b>[$cvstree]</b>"; |
} |
} |
|
|
print " Module path or alias:\n"; |
print " <label for=\"mpath\" accesskey=\"M\">Module path or alias:"; |
print "<INPUT TYPE=TEXT NAME=\"path\" VALUE=\"\" SIZE=15>\n"; |
print "</label>\n"; |
print "<input type=submit value=\"Go\">"; |
print "<input type=\"text\" id=\"mpath\" name=\"path\" value=\"\" size=\"15\">\n"; |
|
print "<input type=\"submit\" value=\"Go\" accesskey=\"O\">"; |
|
|
if (2 <= @CVSROOT) { |
if (2 <= @CVSROOT) { |
print "</td></tr></table>"; |
print "</td>\n</tr>\n</table>"; |
|
} else { |
|
print "</p>"; |
} |
} |
print "</form>"; |
print "\n</form>"; |
} |
} |
|
|
sub chooseMirror() { |
sub chooseMirror() { |
my ($mirror, $moremirrors); |
|
$moremirrors = 0; |
|
|
|
# This code comes from the original BSD-cvsweb |
# This code comes from the original BSD-cvsweb |
# and may not be useful for your site; If you don't |
# and may not be useful for your site; If you don't |
# set %MIRRORS this won't show up, anyway |
# set %MIRRORS this won't show up, anyway. |
# |
scalar(%MIRRORS) or return; |
# Should perhaps exlude the current site somehow.. |
|
if (keys %MIRRORS) { |
|
print "\nThis cvsweb is mirrored in:\n"; |
|
|
|
foreach $mirror (keys %MIRRORS) { |
# Should perhaps exclude the current site somehow... |
print ", " if ($moremirrors); |
print "\n<p>\nThis CVSweb is mirrored in\n"; |
print &link(htmlquote($mirror), $MIRRORS{$mirror}); |
|
$moremirrors = 1; |
my @tmp = map(&link(htmlquote($_), $MIRRORS{$_}), |
} |
sort keys %MIRRORS); |
print "<p>\n"; |
my $tmp = pop(@tmp); |
|
|
|
if (scalar(@tmp)) { |
|
print join(', ', @tmp), ' and '; |
} |
} |
|
|
|
print "$tmp.\n</p>\n"; |
} |
} |
|
|
sub fileSortCmp() { |
sub fileSortCmp() { |
Line 3255 sub fileSortCmp() { |
|
Line 3397 sub fileSortCmp() { |
|
|
|
if ($comp == 0) { |
if ($comp == 0) { |
|
|
# Directories first, then sorted on name if no other sort critera |
# Directories first, then files under version control, |
# available. |
# then other, "rogue" files. |
my $ad = ((-d "$fullname/$a") ? "D" : "F"); |
# Sort by filename if no other criteria available. |
my $bd = ((-d "$fullname/$b") ? "D" : "F"); |
|
|
my $ad = ((-d "$fullname/$a") ? 'D' |
|
: (defined($fileinfo{$af}) ? 'F' : 'R')); |
|
my $bd = ((-d "$fullname/$b") ? 'D' |
|
: (defined($fileinfo{$bf}) ? 'F' : 'R')); |
($c = $a) =~ s|.*/||; |
($c = $a) =~ s|.*/||; |
($d = $b) =~ s|.*/||; |
($d = $b) =~ s|.*/||; |
$comp = ("$ad$c" cmp "$bd$d"); |
$comp = ("$ad$c" cmp "$bd$d"); |
Line 3276 sub download_url($$;$) { |
|
Line 3422 sub download_url($$;$) { |
|
&& (!defined($mimetype) || $mimetype ne "text/x-cvsweb-markup")) |
&& (!defined($mimetype) || $mimetype ne "text/x-cvsweb-markup")) |
{ |
{ |
my $path = $where; |
my $path = $where; |
$path =~ s|/[^/]*$|/|; |
$path =~ s|[^/]+$||; |
$url = "$scriptname/$checkoutMagic/${path}$url"; |
$url = "$scriptname/$checkoutMagic/${path}$url"; |
} |
} |
$url .= "?rev=$revision"; |
$url .= "?rev=$revision"; |
Line 3293 sub download_link($$$;$) { |
|
Line 3439 sub download_link($$$;$) { |
|
|
|
$fullurl =~ s/:/sprintf("%%%02x", ord($&))/eg; |
$fullurl =~ s/:/sprintf("%%%02x", ord($&))/eg; |
|
|
printf '<A HREF="%s"', hrefquote("$fullurl$barequery"); |
printf '<a href="%s"', hrefquote("$fullurl$barequery"); |
|
|
if ($open_extern_window |
if ($open_extern_window |
&& (!defined($mimetype) || $mimetype ne "text/x-cvsweb-markup")) |
&& (!defined($mimetype) || $mimetype ne "text/x-cvsweb-markup")) |
Line 3318 sub download_link($$$;$) { |
|
Line 3464 sub download_link($$$;$) { |
|
# currently, the best way is to comment out the size parameters |
# currently, the best way is to comment out the size parameters |
# ($extern_window...) in cvsweb.conf. |
# ($extern_window...) in cvsweb.conf. |
if ($use_java_script) { |
if ($use_java_script) { |
my @attr = qw(resizeable scrollbars); |
my @attr = qw(resizable scrollbars); |
|
|
push @attr, qw(status toolbar) |
push @attr, qw(status toolbar) |
if (defined($mimetype) && $mimetype eq "text/html"); |
if (defined($mimetype) && $mimetype eq "text/html"); |
Line 3329 sub download_link($$$;$) { |
|
Line 3475 sub download_link($$$;$) { |
|
push @attr, "height=$extern_window_height" |
push @attr, "height=$extern_window_height" |
if (defined($extern_window_height)); |
if (defined($extern_window_height)); |
|
|
|
# We need the "return false" here to prevent browsers |
|
# from following the href after the onclick handler. |
|
# This would effectively load the same document in |
|
# the same window *twice*. |
printf |
printf |
q` onClick="window.open('%s','cvs_checkout','%s');"`, |
q` onclick="window.open('%s','cvs_checkout','%s');return false"`, |
hrefquote($fullurl), join (',', @attr); |
hrefquote("$fullurl$barequery"), join (',', @attr); |
} |
} |
} |
} |
print "><b>$textlink</b></A>"; |
print "><b>$textlink</b></a>"; |
} |
} |
|
|
# Returns a Query string with the |
# Returns a Query string with the |
Line 3430 sub http_header(;$) { |
|
Line 3580 sub http_header(;$) { |
|
if ($is_mod_perl) { |
if ($is_mod_perl) { |
Apache->request->content_type($content_type); |
Apache->request->content_type($content_type); |
} else { |
} else { |
print "Content-type: $content_type\r\n"; |
print "Content-Type: $content_type\r\n"; |
} |
} |
|
|
if ($allow_compress && $maycompress) { |
if ($allow_compress && $maycompress) { |
Line 3445 sub http_header(;$) { |
|
Line 3595 sub http_header(;$) { |
|
Vary => "Accept-Encoding"); |
Vary => "Accept-Encoding"); |
Apache->request->send_http_header; |
Apache->request->send_http_header; |
} else { |
} else { |
print "Content-encoding: x-gzip\r\n"; |
print "Content-Encoding: x-gzip\r\n"; |
print "Vary: Accept-Encoding\r\n" |
print "Vary: Accept-Encoding\r\n" |
; #RFC 2068, 14.43 |
; #RFC 2068, 14.43 |
print "\r\n"; # Close headers |
print "\r\n"; # Close headers |
Line 3467 sub http_header(;$) { |
|
Line 3617 sub http_header(;$) { |
|
print "\r\n"; # Close headers |
print "\r\n"; # Close headers |
} |
} |
print |
print |
"<font size=-1>Unable to find gzip binary in the <b>\$command_path</b> ($command_path) to compress output</font><br>"; |
"<span style=\"font-size: smaller\">Unable to find gzip binary in the <b>\$command_path</b> ($command_path) to compress output</span><br>"; |
} |
} |
} else { |
} else { |
|
|
Line 3482 sub http_header(;$) { |
|
Line 3632 sub http_header(;$) { |
|
sub html_header($) { |
sub html_header($) { |
my ($title) = @_; |
my ($title) = @_; |
http_header("text/html"); |
http_header("text/html"); |
|
|
|
(my $header = &cgi_style::html_header) =~ s,\A.*</head>\n,,s; |
|
|
print <<EOH; |
print <<EOH; |
<!doctype html public "-//W3C//DTD HTML 4.0 Transitional//EN" |
$HTML_DOCTYPE |
"http://www.w3.org/TR/REC-html40/loose.dtd"> |
|
<html> |
<html> |
<head> |
<head> |
<meta name="robots" content="nofollow"> |
|
<title>$title</title> |
<title>$title</title> |
<!-- knu-cvsweb $cvsweb_revision --> |
$HTML_META</head> |
</head> |
$header |
$body_tag |
|
$logo <h1 align="center">$title</h1> |
|
EOH |
EOH |
} |
} |
|
|
sub html_footer() { |
sub html_footer() { |
return "<hr noshade><address>$address</address></body></html>\n"; |
return &cgi_style::html_footer; |
} |
} |
|
|
sub link_tags($) { |
sub link_tags($) { |