cvsweb/cvsweb.cgi - diff

Return to cvsweb.cgi CVS log

Up to [cvsweb.bsd.lv] / cvsweb

Diff for /cvsweb/cvsweb.cgi between version 1.1.1.29 and 1.1.1.36

version 1.1.1.29, 2002/04/10 20:03:49

version 1.1.1.36, 2002/09/30 19:48:52

Line 3

# cvsweb - a CGI interface to CVS trees.

# Written in their spare time by

# Bill Fenner <fenner@FreeBSD.org> (original work)

# extended by Henner Zeller <zeller@think.de>,

# Henrik Nordstrom <hno@hem.passagen.se>

# Ken Coar <coar@Apache.Org>

# Dick Balaska <dick@buckosoft.com>

# Akinori MUSHA <knu@FreeBSD.org>

# Jens-Uwe Mager <jum@helios.de>

# Ville Skyttä <ville.skytta@iki.fi> (html cleanup)

# Ville Skyttä <scop@FreeBSD.org>

# Vassilii Khachaturov <vassilii@tarunz.org>

# Based on:

# * Bill Fenners cvsweb.cgi revision 1.28 available from:

Line 18

Line 19

# Redistribution and use in source and binary forms, with or without

Line 43

Line 45

# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF

# SUCH DAMAGE.

# $FreeBSD: projects/cvsweb/cvsweb.cgi,v 1.90 2002/04/10 19:25:11 knu Exp $

# $FreeBSD: projects/cvsweb/cvsweb.cgi,v 1.119.2.6 2002/09/26 20:56:05 scop Exp $

# $zId: cvsweb.cgi,v 1.112 2001/07/24 13:03:16 hzeller Exp $

# $Idaemons: /home/cvs/cvsweb/cvsweb.cgi,v 1.84 2001/10/07 20:50:10 knu Exp $

Line 64 use vars qw (

Line 66 use vars qw (

@revisions %state %difflines %log %branchpoint @revorder

$prcgi @prcategories $re_prcategories $prkeyword $re_prkeyword $mancgi

$checkoutMagic $doCheckout $scriptname $scriptwhere

$where $pathinfo $Browser $nofilelinks $maycompress @stickyvars

$where $pathinfo $Browser $nofilelinks $maycompress

@stickyvars @unsafevars

%funcline_regexp $is_mod_perl

$is_links $is_lynx $is_w3m $is_msie $is_mozilla3 $is_textbased

%input $query $barequery $sortby $bydate $byrev $byauthor

Line 79 use vars qw (

Line 82 use vars qw (

$columnHeaderColorSorted $hr_breakable $showfunc $hr_ignwhite

$hr_ignkeysubst $diffcolorHeading $diffcolorEmpty $diffcolorRemove

$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

$show_subdir_lastmod $show_log_in_markup $preformat_in_markup $v

$navigationHeaderColor $tableBorderColor $markupLogColor

Line 88 use vars qw (

Line 93 use vars qw (

$module $use_descriptions %descriptions @mytz $dwhere $moddate

$use_moddate $has_zlib $gzip_open

$allow_tar @tar_options @gzip_options @zip_options @cvs_options

$LOG_FILESEPARATOR $LOG_REVSEPARATOR

@annotate_options $LOG_FILESEPARATOR $LOG_REVSEPARATOR

$tmpdir

$tmpdir $HTML_DOCTYPE $HTML_META

);

sub printDiffSelect($);

Line 101 sub htmlify($;$);

Line 106 sub htmlify($;$);

sub spacedHtmlText($;$);

sub link($$);

sub revcmp($$);

sub fatal($$);

sub fatal($$@);

sub redirect($);

sub safeglob($);

sub search_path($);

Line 144 sub forbidden_module($);

Line 149 sub forbidden_module($);

##### Start of Configuration Area ########

delete $ENV{PATH};

$cvsweb_revision = '2.0.1';

$cvsweb_revision = '2.0.6';

use File::Basename;

use File::Basename ();

($mydir) = (dirname($0) =~ /(.*)/); # untaint

($mydir) = (File::Basename::dirname($0) =~ /(.*)/); # untaint

# == EDIT this ==

# Locations to search for user configuration, in order:

Line 163 for ("$mydir/cvsweb.conf", '/usr/local/etc/cvsweb/cvsw

Line 168 for ("$mydir/cvsweb.conf", '/usr/local/etc/cvsweb/cvsw

# Defaults for configuration variables that shouldn't need

# to be configured..

$allow_version_select = 1;

$allow_log_extra = 1;

##### End of Configuration Area ########

Line 181 $cvstreedefault = $body_tag = $body_tag_for_src = $log

Line 187 $cvstreedefault = $body_tag = $body_tag_for_src = $log

$extern_window_width = $extern_window_height = $edit_option_form =

$show_subdir_lastmod = $show_log_in_markup = $v = $navigationHeaderColor =

$tableBorderColor = $markupLogColor = $tabstop = $use_moddate = $moddate =

$gzip_open = undef;

$gzip_open = $HTML_DOCTYPE = $HTML_META = undef;

$tmpdir = defined($ENV{TMPDIR}) ? $ENV{TMPDIR} : "/var/tmp";

$LOG_FILESEPARATOR = q/^={77}$/;

Line 229 $LOG_REVSEPARATOR = q/^-{28}$/;

Line 235 $LOG_REVSEPARATOR = q/^-{28}$/;

);

$HTML_DOCTYPE =

'<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">';

$HTML_META = <<EOM;

EOM

##### 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

# we can avoid using the extra gzip process.

Line 295 $maycompress =

Line 311 $maycompress =

# their current value) to any link/query string

# you construct

@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) {

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 {

&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;

Line 331 if (defined($query) && $query ne '') {

Line 342 if (defined($query) && $query ne '') {

$input{only_with_tag} = $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;

foreach (keys %DEFAULTVALUE) {

Line 409 $defaultDiffType = $input{'f'};

Line 435 $defaultDiffType = $input{'f'};

$logsort = $input{'logsort'};

my @tmp = @CVSrepositories;

{

my @pair;

my @tmp = @CVSrepositories;

my @pair;

while (@pair = splice(@tmp, 0, 2)) {

my ($key, $val) = @pair;

my ($descr, $cvsroot) = @$val;

next if !-d $cvsroot;

$CVSROOTdescr{$key} = $descr;

$CVSROOT{$key} = $cvsroot;

push @CVSROOT, $key;

}

undef @tmp;

undef @pair;

## Default CVS-Tree

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

Line 443 if ($input{'cvsroot'} && $CVSROOT{$input{'cvsroot'}})

Line 468 if ($input{'cvsroot'} && $CVSROOT{$input{'cvsroot'}})

$cvsroot = $CVSROOT{$cvstree};

# create icons out of description

my $k;

foreach my $k (keys %ICONS) {

foreach $k (keys %ICONS) {

no strict 'refs';

my ($itxt, $ipath, $iwidth, $iheight) = @{$ICONS{$k}};

if ($ipath) {

Line 456 foreach $k (keys %ICONS) {

Line 480 foreach $k (keys %ICONS) {

${"${k}icon"} = $itxt;

}

undef $k;

my $config_cvstree = "$config-$cvstree";

# Do some special configuration for cvstrees

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>',

$config_cvstree, $@);

$config_cvstree,

&htmlify($@)

)

);

}

undef $config_cvstree;

Line 506 if ($rewrite) {

Line 525 if ($rewrite) {

undef $rewrite;

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 517 if (!-d $cvsroot) {

Line 535 if (!-d $cvsroot) {

$where =~ m:([^/]*):;

$module = $1;

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.

if ($input{tarball}) {

&fatal("403 Forbidden", "Downloading tarballs is prohibited.")

fatal("403 Forbidden",

'Downloading tarballs is prohibited.')

unless $allow_tar;

my ($module) = ($where =~ m,^/?(.*),); # untaint

$module =~ s,/([^/]*)$,,;

Line 532 if ($input{tarball}) {

Line 553 if ($input{tarball}) {

my ($basedir) = ($module =~ m,([^/]+)$,);

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 $tmpexportdir = "$tmpdir/.cvsweb.$$." . int(time);

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;

Line 555 if ($input{tarball}) {

Line 577 if ($input{tarball}) {

if (system $CMD{cvs}, @cvs_options, '-Qd', $cvsroot, 'export', '-r',

$tag, '-d', "$tmpexportdir/$basedir", $module)

{

@fatal = ("500 Internal Error", "cvs co failure: $!: $module");

@fatal = ("500 Internal Error",

'cvs co failure: %s: %s',

$!, $module);

} else {

$| = 1; # Essential to get the buffering right.

Line 565 if ($input{tarball}) {

Line 589 if ($input{tarball}) {

system

"$CMD{tar} @tar_options -cf - -C $tmpexportdir $basedir | $CMD{gzip} @gzip_options -c"

and @fatal =

("500 Internal Error",

"tar zc failure: $!: $basedir");

'tar zc failure: %s: %s',

$!, $basedir);

} elsif ($ext eq '.zip' && $CMD{zip}) {

print "Content-Type: application/zip\r\n\r\n";

system

"cd $tmpexportdir && $CMD{zip} @zip_options -r - $basedir"

and @fatal =

("500 Internal Error", "zip failure: $!: $basedir");

("500 Internal Error",

'zip failure: %s: %s',

$!, $basedir);

} else {

@fatal =

("500 Internal Error", "unsupported file type");

("500 Internal Error",

'unsupported file type');

}

Line 592 if ($input{tarball}) {

Line 620 if ($input{tarball}) {

###############################

if (-d $fullname) {

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);

closedir($dh);

my @subLevelFiles = findLastModifiedSubdirs(@dir)

Line 608 if (-d $fullname) {

Line 638 if (-d $fullname) {

print $short_instruction;

}

my $descriptions;

if ($use_descriptions && open(DESC, "<$cvsroot/CVSROOT/descriptions"))

if (($use_descriptions) && open(DESC, "<$cvsroot/CVSROOT/descriptions"))

{

while (<DESC>) {

chomp;

my ($dir, $description) = /(\S+)\s+(.*)/;

$descriptions{$dir} = $description;

}

close(DESC);

}

print "<p><a name=\"dirlist\"></a></p>\n";

Line 641 if (-d $fullname) {

Line 671 if (-d $fullname) {

my $infocols = 0;

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 "\" width=\"100%\" cellspacing=\"1\" cellpadding=\"$tablepadding\">\n";

"<table border=\"0\" cellpadding=\"0\" width=\"100%\"><tr><td bgcolor=\"$tableBorderColor\">";

}

"<table width=\"100%\" border=\"0\" cellspacing=\"1\" cellpadding=\"$tablepadding\">\n";

$infocols++;

printf '<tr><th align="left" bgcolor="%s">',

printf "<tr>\n<th style=\"text-align: left; background-color: %s\">",

$byfile ? $columnHeaderColorSorted :

$columnHeaderColorDefault;

Line 665 if (-d $fullname) {

Line 691 if (-d $fullname) {

)

);

}

print "</th>";

print "</th>\n";

# do not display the other column-headers, if we do not have any files

# with revision information:

if (scalar(%fileinfo)) {

$infocols++;

printf '<th align="left" bgcolor="%s">',

printf '<th style="text-align: left; background-color: %s">',

$byrev ? $columnHeaderColorSorted :

$columnHeaderColorDefault;

Line 686 if (-d $fullname) {

Line 712 if (-d $fullname) {

)

);

}

print "</th>";

print "</th>\n";

$infocols++;

printf '<th align="left" bgcolor="%s">',

printf '<th style="text-align: left; background-color: %s">',

$bydate ? $columnHeaderColorSorted :

$columnHeaderColorDefault;

Line 703 if (-d $fullname) {

Line 729 if (-d $fullname) {

)

);

}

print "</th>";

print "</th>\n";

if ($show_author) {

$infocols++;

printf '<th align="left" bgcolor="%s">',

printf '<th style="text-align: left; background-color: %s">',

$byauthor ? $columnHeaderColorSorted :

$columnHeaderColorDefault;

Line 725 if (-d $fullname) {

Line 751 if (-d $fullname) {

)

);

}

print "</th>";

print "</th>\n";

}

$infocols++;

printf '<th align="left" bgcolor="%s">',

printf '<th style="text-align: left; background-color: %s">',

$bylog ? $columnHeaderColorSorted :

$columnHeaderColorDefault;

Line 743 if (-d $fullname) {

Line 769 if (-d $fullname) {

)

);

}

print "</th>";

print "</th>\n";

} elsif ($use_descriptions) {

printf '<th align="left" bgcolor="%s">',

printf '<th style="text-align: left; background-color: s">',

$columnHeaderColorDefault;

print "Description";

print "Description</th>\n";

$infocols++;

}

print "</tr>\n";

Line 784 if (-d $fullname) {

Line 810 if (-d $fullname) {

my $filesexists;

my $filesfound;

foreach (sort { &fileSortCmp } @dir) {

foreach my $file (sort { &fileSortCmp } @dir) {

if ($_ eq '.') {

next;

}

next if ($file eq '.');

# ignore CVS lock and stale NFS files

next if (/^#cvs\.|^,|^\.nfs/);

next if ($file =~ /^#cvs\.|^,|^\.nfs/);

# Check whether to show the CVSROOT path

next if ($input{'hidecvsroot'} && ($_ eq 'CVSROOT'));

next if ($input{'hidecvsroot'} && $file eq 'CVSROOT');

# Check whether the module is in the restricted list

next if ($_ && &forbidden_module($_));

next if ($file && &forbidden_module($file));

# Ignore non-readable files

next if ($input{'hidenonreadable'} && !(-r "$fullname/$_"));

next if ($input{'hidenonreadable'} && !(-r "$fullname/$file"));

if (s|^Attic/||) {

if ($file =~ s|^Attic/||) {

$attic = " (in the Attic) " . $hideAtticToggleLink;

} else {

$attic = "";

}

if ($_ eq '..' || -d "$fullname/$_") {

if ($file eq '..' || -d "$fullname/$file") {

next if ($_ eq '..' && $where eq '/');

next if ($file eq '..' && $where eq '/');

my ($rev, $date, $log, $author, $filename);

my ($rev, $date, $log, $author, $filename) =

($rev, $date, $log, $author, $filename) =

@{$fileinfo{$file}}

@{$fileinfo{$_}}

if (defined($fileinfo{$file}));

if (defined($fileinfo{$_}));

printf "<tr style=\"background-color: %s\">\n<td>",

printf '<tr bgcolor="%s"><td>', $tabcolors[$dirrow % 2]

$tabcolors[$dirrow % 2] if $dirtable;

if $dirtable;

if ($_ eq '..') {

if ($file eq '..') {

$url = "../$query";

if ($nofilelinks) {

print $backicon;

} else {

print &link($backicon, $url);

}

print " ", &link("Parent Directory", $url);

print ' ', &link("Parent Directory", $url);

} else {

$url = './' . urlencode($_) . "/$query";

$url = './' . urlencode($file) . "/$query";

print "<a name=\"$_\"></a>";

print "<a name=\"$file\"></a>";

if ($nofilelinks) {

print $diricon;

} else {

print &link($diricon, $url);

}

print " ", &link("$_/", $url), $attic;

print ' ', &link("$file/", $url), $attic;

if ($_ eq "Attic") {

if ($file eq "Attic") {

print "  ";

print &link(

"[Don't hide]",

Line 850 if (-d $fullname) {

Line 874 if (-d $fullname) {

# Show last change in dir

if ($filename) {

print "</td><td> </td><td> "

print "</td>\n<td> </td>\n<td> "

if ($dirtable);

if ($date) {

print " <i>",

Line 859 if (-d $fullname) {

Line 883 if (-d $fullname) {

}

if ($show_author) {

print "</td><td> " if ($dirtable);

print "</td>\n<td> " if ($dirtable);

print $author;

}

print "</td><td> " if ($dirtable);

print "</td>\n<td> " if ($dirtable);

$filename =~ s%^[^/]+/%%;

print "$filename/$rev";

print "<br>" if ($dirtable);

if ($log) {

print " <font size=\"-1\">",

print " <span style=\"font-size: smaller\">",

&htmlify(

substr($log, 0, $shortLogLen));

substr($log, 0, $shortLogLen), $allow_dir_extra);

if (length $log > 80) {

print "...";

}

print "</font>";

print "</span>";

}

} else {

my ($dwhere) =

($where ne "/" ? $where : "") . $_;

($where ne "/" ? $where : "") . $file;

if ($use_descriptions

&& defined $descriptions{$dwhere})

Line 893 if (-d $fullname) {

Line 917 if (-d $fullname) {

# columns, so that the vertical seperators are visible

my ($cols) = $infocols;

while ($cols > 1) {

print "</td><td> ";

print "</td>\n<td> ";

$cols--;

}

if ($dirtable) {

print "</td></tr>\n";

print "</td>\n</tr>\n";

} else {

print "<br>\n";

}

$dirrow++;

} elsif (s/,v$//) {

} elsif ($file =~ s/,v$//) {

$fileurl = ($attic ? "Attic/" : "") . urlencode($_);

# 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/$file");

$fileurl = ($attic ? "Attic/" : "") . urlencode($file);

$url = './' . $fileurl . $query;

my $rev = '';

my $date = '';

my $log = '';

my $author = '';

$filesexists++;

next if (!defined($fileinfo{$_}));

next if (!defined($fileinfo{$file}));

($rev, $date, $log, $author) = @{$fileinfo{$_}};

my ($rev, $date, $log, $author) = @{$fileinfo{$file}};

$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=\"$file\"></a>";

if ($nofilelinks) {

print $fileicon;

} else {

print &link($fileicon, $url);

}

print " ", &link($_, $url), $attic;

print ' ', &link(htmlquote($file), $url), $attic;

print "</td><td> " if ($dirtable);

print "</td>\n<td> " if ($dirtable);

download_link($fileurl, $rev, $rev,

$defaultViewable ? "text/x-cvsweb-markup" :

undef);

print "</td><td> " if ($dirtable);

print "</td>\n<td> " if ($dirtable);

if ($date) {

print " <i>", readableTime(time() - $date, 0),

"</i>";

}

if ($show_author) {

print "</td><td> " if ($dirtable);

print "</td>\n<td> " if ($dirtable);

print $author;

}

print "</td><td> " if ($dirtable);

print "</td>\n<td> " if ($dirtable);

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) {

print "...";

}

print "</font>";

print "</span>";

}

print "</td>" if ($dirtable);

print "</td>\n" if ($dirtable);

print(($dirtable) ? "</tr>" : "<br>");

$dirrow++;

}

Line 959 if (-d $fullname) {

Line 985 if (-d $fullname) {

print($dirtable ? "</table>\n" : "</menu>\n");

if ($dirtable && defined($tableBorderColor)) {

print "</td></tr></table>";

}

if ($filesexists && !$filesfound) {

"<p><b>NOTE:</b> There are $filesexists files, but none matches the current tag ($input{only_with_tag}).</p>\n";

Line 975 if (-d $fullname) {

Line 997 if (-d $fullname) {

if (scalar %tags || $input{only_with_tag} || $edit_option_form

|| defined($input{"options"}))

{

print "<hr size=\"1\" noshade>";

print "<hr size=\"1\" noshade>\n";

}

if (scalar %tags || $input{only_with_tag}) {

Line 988 if (-d $fullname) {

Line 1010 if (-d $fullname) {

|| $input{$var} ne $DEFAULTVALUE{$var})

&& $input{$var} ne "" && $var ne "only_with_tag");

}

print "<p>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 "<select id=\"only_with_tag\" name=\"only_with_tag\"";

print " onchange=\"this.form.submit()\"" if $use_java_script;

print ">";

print "<option value=\"\">All tags / default branch</option>\n";

Line 1001 if (-d $fullname) {

Line 1024 if (-d $fullname) {

">$tag</option>\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);

print "<input type=\"submit\" value=\"Go\"></p>\n";

print "<input type=\"submit\" value=\"Go\" accesskey=\"G\"></p>\n";

print "</form>\n";

}

Line 1024 if (-d $fullname) {

Line 1048 if (-d $fullname) {

&link("zip archive", "./$basefile.zip$query"

. ($query ? "&" : "?") . "tarball=1");

}

print "</div>";

print "</div>\n";

}

my $formwhere = $scriptwhere;

$formwhere =~ s|Attic/?$|| if ($input{'hideattic'});

if ($edit_option_form || defined($input{"options"})) {

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) {

"<input type=\"hidden\" name=\"cvsroot\" value=\"$cvstree\">\n";

}

print "<center><table cellpadding=\"0\" cellspacing=\"0\">";

print "<center>\n<table cellpadding=\"0\" cellspacing=\"0\">";

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</option>";

print "<label for=\"sortby\" accesskey=\"F\">Sort files by ";

print "</label><select id=\"sortby\" name=\"sortby\">\n";

print "<option value=\"\">File</option>\n";

print "<option", $bydate ? " selected" : "",

" value=\"date\">Age</option>";

" value=\"date\">Age</option>\n";

print "<option", $byauthor ? " selected" : "",

" value=\"author\">Author</option>"

" value=\"author\">Author</option>\n"

if ($show_author);

print "<option", $byrev ? " selected" : "",

" value=\"rev\">Revision</option>";

" value=\"rev\">Revision</option>\n";

print "<option", $bylog ? " selected" : "",

" value=\"log\">Log message</option>";

" 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);

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);

print "</td>";

print "</td>\n";

print "<td><label>Show Attic files: ";

print "<td><label for=\"hideattic\" accesskey=\"A\">";

print "<input name=\"hideattic\" type=\"checkbox\"",

print "Show Attic files: </label>";

$input{'hideattic'} ? " checked" : "", "></label></td></tr>\n";

print "<input id=\"hideattic\" name=\"hideattic\" type=\"checkbox\"",

$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();

}

###############################

# View Files

###############################

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) {

&doCheckout($fullname, $input{'rev'});

gzipclose();

Line 1155 elsif (-f $fullname . ',v') {

Line 1193 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();

Line 1166 sub printDiffSelect($) {

Line 1206 sub printDiffSelect($) {

my ($use_java_script) = @_;

my $f = $input{'f'};

print '<select name="f"';

print '<select id="f" name="f"';

print ' onchange="this.form.submit()"' if $use_java_script;

print '>';

print ">\n";

local $_;

for (@DIFFTYPES) {

printf('<option value="%s"%s>%s</option>', $_,

printf("<option value=\"%s\"%s>%s</option>\n", $_,

$f eq $_ ? ' selected' : '', "\u$DIFFTYPES{$_}{'descr'}");

}

Line 1182 sub printDiffSelect($) {

Line 1222 sub printDiffSelect($) {

sub printLogSortSelect($) {

my ($use_java_script) = @_;

print '<select name="logsort"';

print '<select id="logsort" name="logsort"';

print ' onchange="this.form.submit()"' if $use_java_script;

print '>';

print ">\n";

local $_;

for (@LOGSORTKEYS) {

printf('<option value="%s"%s>%s</option>', $_,

printf("<option value=\"%s\"%s>%s</option>\n", $_,

$logsort eq $_ ? ' selected' : '',

"\u$LOGSORTKEYS{$_}{'descr'}");

}

Line 1210 sub findLastModifiedSubdirs(@) {

Line 1250 sub findLastModifiedSubdirs(@) {

my ($lastmodtime) = undef;

my $dh = do { local (*DH); };

opendir($dh, $dir) || next;

opendir($dh, $dir) or next;

my (@filenames) = readdir($dh);

closedir($dh);

Line 1218 sub findLastModifiedSubdirs(@) {

Line 1258 sub findLastModifiedSubdirs(@) {

$filename = "$dirname/$filename";

my ($file) = "$fullname/$filename";

next if ($filename !~ /,v$/ || !-f $file);

# Skip forbidden files.

(my $f = $file) =~ s/,v$//;

next if forbidden_file($f);

$filename =~ s/,v$//;

my $modtime = -M $file;

Line 1271 sub htmlify($;$) {

Line 1316 sub htmlify($;$) {

if ($extra) {

# 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;

Line 1295 sub htmlify($;$) {

Line 1339 sub htmlify($;$) {

$_;

} while ($_ ne $prev);

$_ = htmlify_sub {

if (defined($re_prcategories)) {

$_ = htmlify_sub {

(\b$re_prcategories/(\d+)\b)

}{

(\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)"

Line 1351 sub spacedHtmlText($;$) {

Line 1397 sub spacedHtmlText($;$) {

s/ /\001nbsp;/g;

}

$_ = htmlify($_);

$_ = htmlify($_, $allow_source_extra);

# unescape

y/\001/&/;

Line 1359 sub spacedHtmlText($;$) {

Line 1405 sub spacedHtmlText($;$) {

return $_;

}

# Note that this doesn't htmlquote the first argument...

sub link($$) {

my ($name, $url) = @_;

Line 1388 sub revcmp($$) {

Line 1435 sub revcmp($$) {

return 0;

}

sub fatal($$) {

sub fatal($$@) {

my ($errcode, $errmsg) = @_;

my ($errcode, $format, @args) = @_;

if ($is_mod_perl) {

Apache->request->status((split (/ /, $errcode))[0]);

} else {

print "Status: $errcode\r\n";

}

html_header("Error");

print "Error: $errmsg\n";

print "<p>Error: ",

print &html_footer;

sprintf($format, map(htmlquote($_), @args)),

"</p>\n";

html_footer();

exit(1);

}

Line 1411 sub redirect($) {

Line 1460 sub redirect($) {

print "Location: $url\r\n";

}

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);

}

Line 1526 sub scan_directives(@) {

Line 1575 sub scan_directives(@) {

sub openOutputFilter() {

return if !defined($output_filter) || $output_filter eq '';

open(STDOUT, "|-") && return;

open(STDOUT, "|-") and return;

# child of child

open(STDERR, '>/dev/null');

exec($output_filter);

exec($output_filter) or exit -1;

exit -1;

}

###############################

Line 1548 sub doAnnotate($$) {

Line 1595 sub doAnnotate($$) {

# make sure the revisions are wellformed, for security

# reasons ..

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\/)?[^\/]*$//;

($filename = $where) =~ s/^.*\///;

Line 1566 sub doAnnotate($$) {

Line 1607 sub doAnnotate($$) {

$| = 1;

$| = 0; # Flush

# Work around a mod_perl bug (?) in order to make open2() work.

# Search for "untie STDIN" in mod_perl mailing list archives.

my $old_stdin;

if ($is_mod_perl && ($old_stdin = tied *STDIN)) {

local $^W = undef;

untie *STDIN;

}

# this annotate version is based on the

# cvs annotate-demo Perl script by Cyclic Software

# It was written by Cyclic Software, http://www.cyclic.com/, and is in

# the public domain.

# we could abandon the use of rlog, rcsdiff and co using

# the cvsserver in a similiar way one day (..after rewrite)

$pid = open2($reader, $writer, $CMD{cvs}, @cvs_options, "server")

$pid = open2($reader, $writer, $CMD{cvs}, @annotate_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');

# Re-tie STDIN if we fiddled around with it earlier, just to be sure.

tie(*STDIN, ref($old_stdin), $old_stdin) if ($old_stdin && !tied(*STDIN));

# OK, first send the request to the server. A simplified example is:

# Root /home/kingdon/zwork/cvsroot

# Argument foo/xx

Line 1629 sub doAnnotate($$) {

Line 1681 sub doAnnotate($$) {

# 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"

# 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();

navigateHeader($scriptwhere, $pathname, $filename, $rev, "annotate");

"<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.

# For example:

Line 1648 sub doAnnotate($$) {

Line 1700 sub doAnnotate($$) {

my ($revprint, $usrprint);

if ($annTable) {

print "<table border=\"0\" cellspacing=\"0\" cellpadding=\"0\">\n";

print "<table style=\"border: none\" cellspacing=\"0\" cellpadding=\"0\">\n";

} else {

print "<pre>";

}

Line 1709 sub doAnnotate($$) {

Line 1761 sub doAnnotate($$) {

# CVS command line client. But for simplicity, we don't.

} elsif ($words[0] eq "error") {

fatal("500 Internal Error",

"Error occured during annotate: <b>$_</b>");

'Error occured during annotate: <b>%s</b>',

$_);

}

Line 1718 sub doAnnotate($$) {

Line 1771 sub doAnnotate($$) {

} else {

print "</pre>";

}

close($reader) || warn "cannot close: $!";

html_footer();

close($reader) or warn "cannot close: $!";

wait;

}

Line 1737 sub doCheckout($$) {

Line 1792 sub doCheckout($$) {

# make sure the revisions a wellformed, for security

# reasons ..

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

if (defined($input{"content-type"})

&& ($input{"content-type"} =~ /\S\/\S/))

Line 1782 sub doCheckout($$) {

Line 1831 sub doCheckout($$) {

# chdir to $tmpdir before to avoid non-readable cgi-bin directories

chdir($tmpdir);

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)) {

&fatal("404 Not Found", "$where is not (any longer) pertinent");

fatal("404 Not Found",

'%s is not (any longer) pertinent',

$where);

}

#===================================================================

Line 1811 sub doCheckout($$) {

Line 1867 sub doCheckout($$) {

}

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;

Line 1837 sub cvswebMarkup($$$) {

Line 1894 sub cvswebMarkup($$$) {

navigateHeader($scriptwhere, $pathname, $filename, $revision, "view");

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 " (";

&download_link($fileurl, $revision, "download");

Line 1858 sub cvswebMarkup($$$) {

Line 1915 sub cvswebMarkup($$$) {

print "Tag: <b>", $input{only_with_tag}, "</b><br>\n"

if $input{only_with_tag};

}

print "</td></tr></table>";

print "</td>\n</tr>\n</table>";

my $url = download_url($fileurl, $revision, $mimetype);

print "<hr noshade>";

Line 1906 sub doDiff($$$$$$) {

Line 1963 sub doDiff($$$$$$) {

my ($rev1, $rev2, $sym1, $sym2, $f1, $f2);

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;

}

Line 1933 sub doDiff($$$$$$) {

Line 1989 sub doDiff($$$$$$) {

# make sure the revisions a wellformed, for security

# reasons ..

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 1949 sub doDiff($$$$$$) {

Line 2006 sub doDiff($$$$$$) {

my $difftype = $DIFFTYPES{$f};

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'}};

Line 1981 sub doDiff($$$$$$) {

Line 2040 sub doDiff($$$$$$) {

if (!open($fh, "-|")) { # child

open(STDERR, ">&STDOUT"); # Redirect stderr to stdout

openOutputFilter();

exec($CMD{rcsdiff}, @difftype, "-r$rev1", "-r$rev2", $fullname);

exec($CMD{rcsdiff}, @difftype, "-r$rev1", "-r$rev2", $fullname) or exit -1;

}

if ($human_readable) {

http_header();

&human_readable_diff($fh, $rev2);

html_footer();

gzipclose();

exit;

} else {

Line 2055 sub getDirLogs($$@) {

Line 2115 sub getDirLogs($$@) {

push (@files, &safeglob("$DirName/*,v"));

push (@files, &safeglob("$DirName/Attic/*,v"))

if (!$input{'hideattic'});

foreach $file (@otherFiles) {

foreach my $file (@otherFiles) {

push (@files, "$DirName/$file");

}

Line 2070 sub getDirLogs($$@) {

Line 2130 sub getDirLogs($$@) {

if (!open($fh, "-|")) { # child

open(STDERR, '>/dev/null'); # rlog may complain; ignore.

openOutputFilter();

exec($CMD{rlog}, @files);

exec($CMD{rlog}, @files) or exit -1;

}

} else {

if (!open($fh, "-|")) { # child

open(STDERR, '>/dev/null'); # rlog may complain; ignore.

openOutputFilter();

exec($CMD{rlog}, '-r', @files);

exec($CMD{rlog}, '-r', @files) or exit -1;

}

$state = "start";

Line 2135 sub getDirLogs($$@) {

Line 2195 sub getDirLogs($$@) {

}

if ($state eq "tags") {

if (/^\s+(.+):\s+([\d\.]+)\s+$/) {

if (/^\s+([^:]+):\s+([\d\.]+)\s*$/) {

push (@filetags, $1);

$symrev{$1} = $2;

$alltags{$1} = 1;

Line 2227 sub getDirLogs($$@) {

Line 2287 sub getDirLogs($$@) {

$state = "log";

$log = '';

next;

} elsif ($rev eq '' && /^revision (.*)$/) {

} elsif ($rev eq '' && /^revision (\d+(?:\.\d+)+).*$/) {

$rev = $1;

$rev = $1; # .*$ eats up the locker(lockers?) info, if any

next;

} else {

$log .= $_;

Line 2242 sub getDirLogs($$@) {

Line 2302 sub getDirLogs($$@) {

}

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);

}

Line 2274 sub readLog($;$) {

Line 2333 sub readLog($;$) {

if (!open($fh, "-|")) { # child

if ($revision ne '') {

openOutputFilter();

exec($CMD{rlog}, $revision, $fullname);

exec($CMD{rlog}, $revision, $fullname) or exit -1;

} else {

openOutputFilter();

exec($CMD{rlog}, $fullname);

exec($CMD{rlog}, $fullname) or exit -1;

}

Line 2307 sub readLog($;$) {

Line 2366 sub readLog($;$) {

# date: 1995/11/29 22:15:52; author: fenner; state: Exp; lines: +5 -3

# log info

# ----------------------------

# For a locked revision, the first line after the separator

# becomes smth like

# revision 9.19 locked by: vassilii;

logentry:

while (!/$LOG_FILESEPARATOR/o) {

$_ = <$fh>;

last logentry if (!defined($_)); # EOF

print "R:", $_ if ($verbose);

if (/^revision ([\d\.]+)/) {

if (/^revision (\d+(?:\.\d+)+)/) {

$rev = $1;

unshift (@allrevisions, $rev);

} elsif (/$LOG_FILESEPARATOR/o || /$LOG_REVSEPARATOR/o) {

Line 2328 sub readLog($;$) {

Line 2392 sub readLog($;$) {

# these lines since we don't know what revision they go with

# any more.

next logentry;

# &fatal("500 Internal Error","Error parsing RCS output: $_");

}

$_ = <$fh>;

print "D:", $_ if ($verbose);

Line 2349 sub readLog($;$) {

Line 2411 sub readLog($;$) {

$state{$rev} = $8;

$difflines{$rev} = $10;

} else {

&fatal("500 Internal Error",

fatal("500 Internal Error",

"Error parsing RCS output: $_");

'Error parsing RCS output: %s',

$_);

}

line:

Line 2457 sub readLog($;$) {

Line 2520 sub readLog($;$) {

if (!defined($onlyonbranch) || $onlybranchpoint eq "") {

fatal("404 Tag not found",

"Tag $input{'only_with_tag'} not defined");

'Tag %s not defined',

$input{'only_with_tag'});

}

Line 2516 sub printLog($;$) {

Line 2580 sub printLog($;$) {

$link = 1 if (!defined($link));

$isDead = ($state{$_} eq "dead");

print "<p>\n";

if ($link && !$isDead) {

my ($filename);

($filename = $where) =~ s/^.*\///;

Line 2637 sub printLog($;$) {

Line 2702 sub printLog($;$) {

my %diffrev = ();

$diffrev{$_} = 1;

$diffrev{""} = 1;

print "<br>Diff";

print '<br>';

my $diff = 'Diff';

# Offer diff to previous revision

Line 2648 sub printLog($;$) {

Line 2714 sub printLog($;$) {

sprintf('%s.diff?r1=%s&r2=%s%s', $scriptwhere,

$prev, $_, $barequery);

print " to previous ";

print $diff, " to previous ";

$diff = '';

printDiffLinks($prev, $url);

}

Line 2662 sub printLog($;$) {

Line 2729 sub printLog($;$) {

sprintf('%s.diff?r1=%s&r2=%s%s', $scriptwhere, $brp,

$_, $barequery);

print " to branchpoint ";

print $diff, " to branchpoint ";

$diff = '';

printDiffLinks($brp, $url);

}

Line 2704 sub printLog($;$) {

Line 2772 sub printLog($;$) {

$scriptwhere, $nextmain, $_,

$barequery);

print " next main ";

print $diff, " next main ";

$diff = '';

printDiffLinks($nextmain, $url);

}

Line 2718 sub printLog($;$) {

Line 2787 sub printLog($;$) {

sprintf('%s.diff?r1=%s&r2=%s%s', $scriptwhere,

$input{'r1'}, $_, $barequery);

print " to selected ";

print $diff, " to selected ";

$diff = '';

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";

}

Line 2737 sub doLog($) {

Line 2808 sub doLog($) {

($upwhere = $where) =~ s|(Attic/)?[^/]+$||;

($filename = $where) =~ s|^.*/||;

$backurl = $scriptname . "/" . urlencode($upwhere) . $query;

print "<p>\n ";

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 '<hr noshade>';

print "\n</p>\n<hr noshade>\n";

print "<p>\n";

if ($curbranch) {

print "Default branch: ", ($revsym{$curbranch} || $curbranch);

} else {

Line 2752 sub doLog($) {

Line 2826 sub doLog($) {

if ($input{only_with_tag}) {

print "Current tag: $input{only_with_tag}<br>\n";

}

print "</p>\n";

undef %nameprinted;

for (my $i = 0 ; $i <= $#revdisplayorder ; $i++) {

print "<hr size=\"1\" noshade>";

print "<hr size=\"1\" noshade>\n";

printLog($revdisplayorder[$i]);

}

print "<hr noshade>";

print "<hr noshade>\n<p>\n";

print "<a name=\"diff\">\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 "name using the selection box or you may type in a numeric\n";

print "name using the type-in text box.\n";

print "</a><p>\n";

print "</a>\n</p>\n";

"<form method=\"get\" action=\"${scriptwhere}.diff\" name=\"diff_select\">\n";

Line 2777 sub doLog($) {

Line 2852 sub doLog($) {

&& ((!defined($DEFAULTVALUE{$_})

|| $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 "<select id=\"r1\" name=\"r1\">\n";

print "<option value=\"text\" selected>Use Text Field</option>\n";

print $sel;

print "</select>\n";

$diffrev = $revdisplayorder[$#revdisplayorder];

$diffrev = $input{"r1"} if (defined($input{"r1"}));

"<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 "<select id=\"r2\" name=\"r2\">\n";

print "<option value=\"text\" selected>Use Text Field</option>\n";

print $sel;

print "</select>\n";

$diffrev = $revdisplayorder[0];

$diffrev = $input{"r2"} if (defined($input{"r2"}));

"<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 "</tr>\n</table>\n";

print "</form>\n";

print "</tr></table>\n";

print "<hr noshade>\n";

print "<table>";

print "<form method=\"get\" action=\"$scriptwhere\">\n";

print "<tr><td align=\"right\">Preferred Diff type:</td>";

print "<table style=\"border: none\">\n";

print "<tr>\n<td align=\"right\">";

print "<label for=\"f\" accesskey=\"D\">Preferred Diff type:";

print "</label></td>\n";

print "<td>";

printDiffSelect($use_java_script);

print "</td><td></td></tr>\n";

print "</td>\n<td></td>\n</tr>\n";

if (@branchnames) {

print "<tr><td align=\"right\">View only Branch:</td>";

print "<tr>\n<td align=\"right\">";

print "<label for=\"only_with_tag\" accesskey=\"B\">";

print "View only Branch:</label></td>\n";

print "<td>";

print "<a name=\"branch\"></a>\n";

print "<select name=\"only_with_tag\"";

print "<select id=\"only_with_tag\" name=\"only_with_tag\"";

print " onchange=\"this.form.submit()\"" if $use_java_script;

print ">\n";

print "<option value=\"\"";

Line 2828 sub doLog($) {

Line 2909 sub doLog($) {

&& $input{"only_with_tag"} eq $_);

print ">${_}</option>\n";

}

print "</select></td><td></td></tr>\n";

print "</select></td>\n<td></td>\n</tr>\n";

}

foreach (@stickyvars) {

Line 2840 sub doLog($) {

Line 2921 sub doLog($) {

&& (!defined($DEFAULTVALUE{$_})

|| $input{$_} ne $DEFAULTVALUE{$_}) && $input{$_} ne "");

}

print "<tr><td align=\"right\">";

print "<tr>\n<td align=\"right\">";

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);

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 "</tr>\n</table>\n";

print "</form>\n";

print "</tr></table>";

html_footer();

print &html_footer;

}

sub flush_diff_rows($$$$) {

Line 2863 sub flush_diff_rows($$$$) {

Line 2944 sub flush_diff_rows($$$$) {

if ($state eq "PreChangeRemove") { # we just got remove-lines before

for ($j = 0 ; $j < $leftRow ; $j++) {

"<tr><td bgcolor=\"$diffcolorRemove\">@$leftColRef[$j]</td>";

"<tr>\n<td class=\"diff-removed\"> @$leftColRef[$j]</td>\n";

"<td bgcolor=\"$diffcolorEmpty\"> </td></tr>\n";

"<td class=\"diff-empty\"> </td>\n</tr>\n";

}

} elsif ($state eq "PreChange") { # state eq "PreChange"

# we got removes with subsequent adds

for ($j = 0 ; $j < $leftRow || $j < $rightRow ; $j++)

{ # dump out both cols

print "<tr>";

print "<tr>\n";

if ($j < $leftRow) {

"<td bgcolor=\"$diffcolorChange\">@$leftColRef[$j]</td>";

"<td class=\"diff-changed\"> @$leftColRef[$j]</td>";

} else {

"<td bgcolor=\"$diffcolorDarkChange\"> </td>";

"<td class=\"diff-changed-missing\"> </td>";

}

print "\n";

if ($j < $rightRow) {

"<td bgcolor=\"$diffcolorChange\">@$rightColRef[$j]</td>";

"<td class=\"diff-changed\"> @$rightColRef[$j]</td>";

} else {

"<td bgcolor=\"$diffcolorDarkChange\"> </td>";

"<td class=\"diff-changed-missing\"> </td>";

}

print "</tr>\n";

print "\n</tr>\n";

}

Line 2927 sub human_readable_diff($) {

Line 3009 sub human_readable_diff($) {

}

"<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",

# Using style=\"border: none\" here breaks NS 4.x badly...

"<table border=\"0\" cellspacing=\"0\" cellpadding=\"0\" width=\"100%\">\n",

"<tr bgcolor=\"#ffffff\">\n", "<th width=\"50%\" valign=\"top\">",

"<tr style=\"background-color: #ffffff\">\n", "<th width=\"50%\" valign=\"top\">",

"version $rev1";

print ", $date1" if (defined($date1));

print "<br>Tag: $sym1\n" if ($sym1);

Line 2938 sub human_readable_diff($) {

Line 3021 sub human_readable_diff($) {

print "<br>Tag: $sym2\n" if ($sym1);

print "</th>\n";

my $fs = "<font face=\"$difffontface\" size=\"$difffontsize\"><tt>";

my $fe = "</tt></font>";

my $leftRow = 0;

my $rightRow = 0;

my ($oldline, $newline, $funname, $diffcode, $rest);

# 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

my @buf = head($fh);

Line 2963 sub human_readable_diff($) {

Line 3039 sub human_readable_diff($) {

($oldline, $newline, $funname) =

$difftxt =~ /@@ \-([0-9]+).*\+([0-9]+).*@@(.*)/;

$funname = htmlquote($funname);

$funname =~ s/\s/ /go;

"<tr bgcolor=\"$diffcolorHeading\"><td width=\"50%\">";

"<tr class=\"diff-heading\">\n<td width=\"50%\">";

"<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>";

" <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%\">";

"<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>";

" <font size=\"-1\">$funname</font></td></tr></table>";

" <span style=\"font-size: smaller\">$funname</span></td>\n</tr>\n</table>\n";

print "</td>\n";

$state = "dump";

$leftRow = 0;

Line 2982 sub human_readable_diff($) {

Line 3059 sub human_readable_diff($) {

($diffcode, $rest) = $difftxt =~ /^([-+ ])(.*)/;

$_ = spacedHtmlText($rest, $d{'tabstop'});

# Add fontface, size

$_ = "$fs $_$fe";

#########

# little state machine to parse unified-diff output (Hen, zeller@think.de)

# in order to get some nice 'ediff'-mode output

Line 2998 sub human_readable_diff($) {

Line 3072 sub human_readable_diff($) {

if ($state eq "dump")

{ # 'change' never begins with '+': just dump out value

"<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

$state = "PreChange";

$rightCol[$rightRow++] = $_;

Line 3009 sub human_readable_diff($) {

Line 3083 sub human_readable_diff($) {

} else { # empty diffcode

flush_diff_rows \@leftCol, \@rightCol, $leftRow,

$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";

$leftRow = 0;

$rightRow = 0;

Line 3022 sub human_readable_diff($) {

Line 3096 sub human_readable_diff($) {

# state is empty if we didn't have any change

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";

"<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";

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 "<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";

"<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";

"<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";

"<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 "<form method=\"get\" action=\"${scriptwhere}\">\n";

foreach my $var (keys %input) {

next if ($var eq "f");

Line 3060 sub human_readable_diff($) {

Line 3129 sub human_readable_diff($) {

}

printDiffSelect($use_java_script);

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($$$$$) {

Line 3071 sub navigateHeader($$$$$) {

Line 3140 sub navigateHeader($$$$$) {

$swhere = "" if ($swhere eq $scriptwhere);

$swhere = './' . urlencode($filename) if ($swhere eq "");

# TODO: this should be moved into external CSS file.

my $css = '';

if ($title eq 'diff') {

$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;

<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">

$HTML_DOCTYPE

<html>

<head>

<title>$path$filename - $title - $rev</title>$css

$HTML_META</head>

<title>$path$filename - $title - $rev</title>

</head>

$body_tag_for_src

EOF

Line 3195 sub clickablePath($$) {

Line 3298 sub clickablePath($$) {

}

sub chooseCVSRoot() {

print "<form method=\"get\" action=\"${scriptwhere}\">\n";

if (2 <= @CVSROOT) {

my ($k);

print "<form method=\"GET\" action=\"${scriptwhere}\">\n";

foreach $k (keys %input) {

print "<input type=\"hidden\" name=\"$k\" value=\"$input{$k}\">\n"

if ($input{$k}) && ($k ne "cvsroot");

Line 3206 sub chooseCVSRoot() {

Line 3310 sub chooseCVSRoot() {

# Form-Elements look wierd in Netscape if the background

# isn't gray and the form elements are not placed

# 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=\"this.form.submit()\"" if $use_java_script;

print ">\n";

Line 3218 sub chooseCVSRoot() {

Line 3322 sub chooseCVSRoot() {

print ">",($CVSROOTdescr{$k} ? $CVSROOTdescr{$k} : $k),

"</option>\n";

}

print "</select>\n</td>";

print "</select>\n</td>\n<td>";

print "<td>";

} 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 " 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) {

print "</td></tr></table>";

print "</td>\n</tr>\n</table>";

} else {

print "</p>";

}

print "</form>";

print "\n</form>";

}

sub chooseMirror() {

my ($mirror, $moremirrors);

$moremirrors = 0;

# This code comes from the original BSD-cvsweb

# 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() {

Line 3283 sub fileSortCmp() {

Line 3390 sub fileSortCmp() {

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|.*/||;

($d = $b) =~ s|.*/||;

$comp = ("$ad$c" cmp "$bd$d");

Line 3346 sub download_link($$$;$) {

Line 3457 sub download_link($$$;$) {

# currently, the best way is to comment out the size parameters

# ($extern_window...) in cvsweb.conf.

if ($use_java_script) {

my @attr = qw(resizeable scrollbars);

my @attr = qw(resizable scrollbars);

push @attr, qw(status toolbar)

if (defined($mimetype) && $mimetype eq "text/html");

Line 3363 sub download_link($$$;$) {

Line 3474 sub download_link($$$;$) {

# the same window *twice*.

printf

q` onclick="window.open('%s','cvs_checkout','%s');return false"`,

hrefquote($fullurl), join (',', @attr);

hrefquote("$fullurl$barequery"), join (',', @attr);

}

print "><b>$textlink</b></a>";

Line 3499 sub http_header(;$) {

Line 3610 sub http_header(;$) {

print "\r\n"; # Close headers

}

"<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 {

Line 3515 sub html_header($) {

Line 3626 sub html_header($) {

my ($title) = @_;

http_header("text/html");

print <<EOH;

<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">

$HTML_DOCTYPE

<html>

<head>

<title>$title</title>

$HTML_META</head>

</head>

$body_tag

$logo <h1 align="center">$title</h1>

EOH

}

sub html_footer() {

return "<hr noshade><address>$address</address></body></html>\n";

print "<hr noshade>\n<address>$address</address>\n" if $address;

print "</body>\n</html>\n";

}

sub link_tags($) {

CVSweb