===================================================================
RCS file: /cvs/cvsweb/cvsweb.cgi,v
retrieving revision 1.1
retrieving revision 1.1.1.34
diff -u -p -r1.1 -r1.1.1.34
--- cvsweb/cvsweb.cgi 1996/09/28 23:31:06 1.1
+++ cvsweb/cvsweb.cgi 2002/09/26 22:09:02 1.1.1.34
@@ -1,526 +1,3771 @@
-#!/usr/bin/perl -s
+#!/usr/bin/perl -wT
#
-# cvsweb - a CGI interface to the CVS tree.
+# cvsweb - a CGI interface to CVS trees.
#
-# Written by Bill Fenner on his own time.
-# Insert BSD copyright here.
+# Written in their spare time by
+# Bill Fenner (original work)
+# extended by Henner Zeller ,
+# Henrik Nordstrom
+# Ken Coar
+# Dick Balaska
+# Akinori MUSHA
+# Jens-Uwe Mager
+# Ville Skyttä
+# Vassilii Khachaturov
#
-#HTTP_USER_AGENT: Mozilla/1.1N (X11; I; SunOS 4.1.3_U1 sun4m) via proxy gateway CERN-HTTPD/3.0 libwww/2.17
-#SERVER_NAME: www.freebsd.org
-#QUERY_STRING: baz
-#SCRIPT_FILENAME: /usr/local/www/cgi-bin/env.pl
-#SERVER_PORT: 80
-#HTTP_ACCEPT: */*, image/gif, image/x-xbitmap, image/jpeg
-#SERVER_PROTOCOL: HTTP/1.0
-#HTTP_COOKIE: s=beta26429821397802167
-#PATH_INFO: /foo/bar
-#REMOTE_ADDR: 13.1.64.94
-#DOCUMENT_ROOT: /usr/local/www/data/
-#PATH: /sbin:/bin:/usr/sbin:/usr/bin
-#PATH_TRANSLATED: /usr/local/www/data//foo/bar
-#GATEWAY_INTERFACE: CGI/1.1
-#REQUEST_METHOD: GET
-#SCRIPT_NAME: /cgi-bin/env.pl
-#SERVER_SOFTWARE: Apache/1.0.0
-#REMOTE_HOST: beta.xerox.com
-#SERVER_ADMIN: webmaster@freebsd.org
+# Based on:
+# * Bill Fenners cvsweb.cgi revision 1.28 available from:
+# http://www.FreeBSD.org/cgi/cvsweb.cgi/www/en/cgi/cvsweb.cgi
#
-require 'timelocal.pl';
-require 'ctime.pl';
+# Copyright (c) 1996-1998 Bill Fenner
+# (c) 1998-1999 Henner Zeller
+# (c) 1999 Henrik Nordstrom
+# (c) 2000-2002 Akinori MUSHA
+# (c) 2002 Ville Skyttä‹# All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions
+# are met:
+# 1. Redistributions of source code must retain the above copyright
+# notice, this list of conditions and the following disclaimer.
+# 2. Redistributions in binary form must reproduce the above copyright
+# notice, this list of conditions and the following disclaimer in the
+# documentation and/or other materials provided with the distribution.
+#
+# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
+# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+# ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
+# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+# 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 $
+# $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.85 2002/07/23 16:27:04 scop Exp $
+#
+###
-$cvsroot = '/home/ncvs';
-$intro = "
-This is a WWW interface to the FreeBSD CVS tree.
-You can browse the file hierarchy by picking directories
-(which have slashes after them, e.g. src/).
-If you pick a file, you will see the revision history
-for that file.
-Selecting a revision number will download that revision of
-the file. There is a link at each revision to display
-diffs between that revision and the previous one, and
-a form at the bottom of the page that allows you to
-display diffs between arbitrary revisions.
-
-Please send any suggestions, comments, etc. to
-Bill Fenner <fenner@freebsd.org>
-";
-$shortinstr = "
-Click on a directory to enter that directory. Click on a file to display
-its revision history and to get a
-chance to display diffs between revisions.
-";
+require 5.000;
-$verbose = $v;
-($where = $ENV{'PATH_INFO'}) =~ s|^/||;
-$where =~ s|/$||;
-$fullname = $cvsroot . '/' . $where;
-($scriptname = $ENV{'SCRIPT_NAME'}) =~ s|^/?|/|;
-$scriptname =~ s|/$||;
-$scriptwhere = $scriptname . '/' . $where;
-$scriptwhere =~ s|/$||;
+use strict;
+use vars qw (
+ $cvsweb_revision
+ $mydir $uname $config $allow_version_select $verbose
+ @CVSrepositories @CVSROOT %CVSROOT %CVSROOTdescr
+ %MIRRORS %DEFAULTVALUE %ICONS %MTYPES
+ @DIFFTYPES %DIFFTYPES @LOGSORTKEYS %LOGSORTKEYS
+ %alltags @tabcolors %fileinfo %tags @branchnames %nameprinted
+ %symrev %revsym @allrevisions %date %author @revdisplayorder
+ @revisions %state %difflines %log %branchpoint @revorder
+ $prcgi @prcategories $re_prcategories $prkeyword $re_prkeyword $mancgi
+ $checkoutMagic $doCheckout $scriptname $scriptwhere
+ $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
+ $bylog $byfile $defaultDiffType $logsort $cvstree $cvsroot
+ $mimetype $charset $output_filter $defaultTextPlain $defaultViewable
+ $command_path %CMD $allow_compress
+ $backicon $diricon $fileicon
+ $fullname $newname $cvstreedefault
+ $body_tag $body_tag_for_src $logo $defaulttitle $address
+ $long_intro $short_instruction $shortLogLen
+ $show_author $dirtable $tablepadding $columnHeaderColorDefault
+ $columnHeaderColorSorted $hr_breakable $showfunc $hr_ignwhite
+ $hr_ignkeysubst $diffcolorHeading $diffcolorEmpty $diffcolorRemove
+ $diffcolorChange $diffcolorAdd $diffcolorDarkChange $difffontface
+ $difffontsize $inputTextSize $mime_types
+ $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
+ $tabstop $state $annTable $sel $curbranch @HideModules @ForbiddenFiles
+ $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
+ $tmpdir $HTML_DOCTYPE $HTML_META
+);
+
+sub printDiffSelect($);
+sub printDiffLinks($$);
+sub printLogSortSelect($);
+sub findLastModifiedSubdirs(@);
+sub htmlify_sub(&$);
+sub htmlify($;$);
+sub spacedHtmlText($;$);
+sub link($$);
+sub revcmp($$);
+sub fatal($$@);
+sub redirect($);
+sub safeglob($);
+sub search_path($);
+sub getMimeTypeFromSuffix($);
+sub head($;$);
+sub scan_directives(@);
+sub openOutputFilter();
+sub doAnnotate($$);
+sub doCheckout($$);
+sub cvswebMarkup($$$);
+sub viewable($);
+sub doDiff($$$$$$);
+sub getDirLogs($$@);
+sub readLog($;$);
+sub printLog($;$);
+sub doLog($);
+sub flush_diff_rows($$$$);
+sub human_readable_diff($);
+sub navigateHeader($$$$$);
+sub plural_write($$);
+sub readableTime($$);
+sub clickablePath($$);
+sub chooseCVSRoot();
+sub chooseMirror();
+sub fileSortCmp();
+sub download_url($$;$);
+sub download_link($$$;$);
+sub toggleQuery($$);
+sub urlencode($);
+sub htmlquote($);
+sub htmlunquote($);
+sub hrefquote($);
+sub http_header(;$);
+sub html_header($);
+sub html_footer();
+sub link_tags($);
+sub forbidden_file($);
+sub forbidden_module($);
+
+##### Start of Configuration Area ########
+delete $ENV{PATH};
+
+$cvsweb_revision = '2.0.5';
+
+use File::Basename ();
+
+($mydir) = (File::Basename::dirname($0) =~ /(.*)/); # untaint
+
+# == EDIT this ==
+# Locations to search for user configuration, in order:
+for ("$mydir/cvsweb.conf", '/usr/local/etc/cvsweb/cvsweb.conf') {
+ if (defined($_) && -r $_) {
+ $config = $_;
+ last;
+ }
+}
+
+# == Configuration defaults ==
+# Defaults for configuration variables that shouldn't need
+# to be configured..
+$allow_version_select = 1;
+$allow_log_extra = 1;
+
+##### End of Configuration Area ########
+
+######## Configuration variables #########
+# These are defined to allow checking with perl -cw
+@CVSrepositories = @CVSROOT = %CVSROOT = %MIRRORS = %DEFAULTVALUE = %ICONS =
+ %MTYPES = %tags = %alltags = @tabcolors = %fileinfo = ();
+$cvstreedefault = $body_tag = $body_tag_for_src = $logo = $defaulttitle =
+ $address = $long_intro = $short_instruction = $shortLogLen = $show_author =
+ $dirtable = $tablepadding = $columnHeaderColorDefault =
+ $columnHeaderColorSorted = $hr_breakable = $showfunc = $hr_ignwhite =
+ $hr_ignkeysubst = $diffcolorHeading = $diffcolorEmpty = $diffcolorRemove =
+ $diffcolorChange = $diffcolorAdd = $diffcolorDarkChange = $difffontface =
+ $difffontsize = $inputTextSize = $mime_types = $allow_annotate =
+ $allow_markup = $use_java_script = $open_extern_window =
+ $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 = $HTML_DOCTYPE = $HTML_META = undef;
+$tmpdir = defined($ENV{TMPDIR}) ? $ENV{TMPDIR} : "/var/tmp";
+
+$LOG_FILESEPARATOR = q/^={77}$/;
+$LOG_REVSEPARATOR = q/^-{28}$/;
+
+@DIFFTYPES = qw(h H u c s);
+@DIFFTYPES{@DIFFTYPES} = (
+ {
+ 'descr' => 'colored',
+ 'opts' => ['-u'],
+ 'colored' => 1,
+ },
+ {
+ 'descr' => 'long colored',
+ 'opts' => ['--unified=15'],
+ 'colored' => 1,
+ },
+ {
+ 'descr' => 'unified',
+ 'opts' => ['-u'],
+ 'colored' => 0,
+ },
+ {
+ 'descr' => 'context',
+ 'opts' => ['-c'],
+ 'colored' => 0,
+ },
+ {
+ 'descr' => 'side by side',
+ 'opts' => ['--side-by-side', '--width=164'],
+ 'colored' => 0,
+ },
+);
+
+@LOGSORTKEYS = qw(cvs date rev);
+@LOGSORTKEYS{@LOGSORTKEYS} = (
+ {
+ 'descr' => 'Not sorted',
+ },
+ {
+ 'descr' => 'Commit date',
+ },
+ {
+ 'descr' => 'Revision',
+ },
+);
+
+$cgi_style::hsty_base = 'http://www.FreeBSD.org';
+$_ = q$FreeBSD: www/en/cgi/cvsweb.cgi,v 1.85 2002/07/23 16:27:04 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 =
+ '';
+
+$HTML_META = <
+
+
+
+EOM
+
+##### End of configuration variables #####
+
+use Time::Local ();
+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.
+eval { require Compress::Zlib; };
+$has_zlib = !$@;
+
+$verbose = $v;
+$checkoutMagic = "~checkout~";
+$pathinfo = defined($ENV{PATH_INFO}) ? $ENV{PATH_INFO} : '';
+$where = $pathinfo;
+$doCheckout = ($where =~ m|^/$checkoutMagic/|);
+$where =~ s|^/$checkoutMagic/|/|;
+$where =~ s|^/||;
+$scriptname = defined($ENV{SCRIPT_NAME}) ? $ENV{SCRIPT_NAME} : '';
+$scriptname =~ s|^/*|/|;
+
+# Let's workaround thttpd's stupidity..
+if ($scriptname =~ m|/$|) {
+ $pathinfo .= '/';
+ my $re = quotemeta $pathinfo;
+ $scriptname =~ s/$re$//;
+}
+
+$scriptwhere = $scriptname;
+$scriptwhere .= '/' . urlencode($where);
+$where = '/' if ($where eq '');
+
+$is_mod_perl = defined($ENV{MOD_PERL});
+
+# in lynx, it it very annoying to have two links
+# per file, so disable the link at the icon
+# in this case:
+$Browser = $ENV{HTTP_USER_AGENT} || '';
+$is_links = ($Browser =~ m`^Links `);
+$is_lynx = ($Browser =~ m`^Lynx/`i);
+$is_w3m = ($Browser =~ m`^w3m/`i);
+$is_msie = ($Browser =~ m`MSIE`);
+$is_mozilla3 = ($Browser =~ m`^Mozilla/[3-9]`);
+
+$is_textbased = ($is_links || $is_lynx || $is_w3m);
+
+$nofilelinks = $is_textbased;
+
+# newer browsers accept gzip content encoding
+# and state this in a header
+# (netscape did always but didn't state it)
+# It has been reported that these
+# braindamaged MS-Internet Exploders claim that they
+# accept gzip .. but don't in fact and
+# display garbage then :-/
+# Turn off gzip if running under mod_perl and no zlib is available,
+# piping does not work as expected inside the server.
+$maycompress =
+ (((defined($ENV{HTTP_ACCEPT_ENCODING})
+ && $ENV{HTTP_ACCEPT_ENCODING} =~ m`gzip`) || $is_mozilla3) && !$is_msie
+ && !($is_mod_perl && !$has_zlib));
+
+# put here the variables we need in order
+# to hold our state - they will be added (with
+# 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) {
+ do "$config" or fatal("500 Internal Error",
+ 'Error in loading configuration file: %s
%s ',
+ $config, $@);
+} else {
+ fatal("500 Internal Error",
+ 'Configuration not found. Set the variable $config in cvsweb.cgi to your cvsweb.conf configuration file first.'
+ );
+}
+
+undef %input;
+$query = $ENV{QUERY_STRING};
+
+if (defined($query) && $query ne '') {
+ foreach (split (/&/, $query)) {
+ y/+/ /;
+ s/%(..)/sprintf("%c", hex($1))/ge; # unquote %-quoted
+ if (/(\S+)=(.*)/) {
+ $input{$1} = $2 if ($2 ne "");
+ } else {
+ $input{$_}++;
+ }
+ }
+}
+
+# For backwards compability, set only_with_tag to only_on_branch if set.
+$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) {
+
+ # replace not given parameters with the default parameters
+ if (!defined($input{$_}) || $input{$_} eq "") {
+
+ # Empty Checkboxes in forms return -- nothing. So we define a helper
+ # variable in these forms (copt) which indicates that we just set
+ # parameters with a checkbox
+ if (!defined($input{"copt"})) {
+
+ # 'copt' isn't defined --> empty input is not the result
+ # of empty input checkbox --> set default
+ $input{$_} = $DEFAULTVALUE{$_}
+ if (defined($DEFAULTVALUE{$_}));
+ } else {
+
+ # 'copt' is defined -> the result of empty input checkbox
+ # -> set to zero (disable) if default is a boolean (0|1).
+ $input{$_} = 0
+ if (defined($DEFAULTVALUE{$_})
+ && ($DEFAULTVALUE{$_} eq "0"
+ || $DEFAULTVALUE{$_} eq "1"));
+ }
+ }
+}
+
+$barequery = "";
+my @barequery;
+foreach (@stickyvars) {
+
+ # construct a query string with the sticky non default parameters set
+ if (defined($input{$_}) && $input{$_} ne ''
+ && !(defined($DEFAULTVALUE{$_}) && $input{$_} eq $DEFAULTVALUE{$_}))
+ {
+ push @barequery,
+ join ('=', urlencode($_), urlencode($input{$_}));
+ }
+}
+
+# is there any query ?
+if (@barequery) {
+ $barequery = join ('&', @barequery);
+ $query = "?$barequery";
+ $barequery = "&$barequery";
+} else {
+ $query = "";
+}
+undef @barequery;
+
+if (defined($input{path})) {
+ redirect("$scriptname/$input{path}$query");
+}
+
+# get actual parameters
+$sortby = $input{"sortby"};
+$bydate = 0;
+$byrev = 0;
+$byauthor = 0;
+$bylog = 0;
+$byfile = 0;
+if ($sortby eq "date") {
+ $bydate = 1;
+} elsif ($sortby eq "rev") {
+ $byrev = 1;
+} elsif ($sortby eq "author") {
+ $byauthor = 1;
+} elsif ($sortby eq "log") {
+ $bylog = 1;
+} else {
+ $byfile = 1;
+}
+
+$defaultDiffType = $input{'f'};
+
+$logsort = $input{'logsort'};
+
+{
+ 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;
+ }
+}
+
+## Default CVS-Tree
+if (!defined($CVSROOT{$cvstreedefault})) {
+ fatal("500 Internal Error",
+ '$cvstreedefault points to a repository (%s) not defined in %%CVSROOT (edit your configuration file %s)',
+ $cvstreedefault, $config);
+}
+
+# alternate CVS-Tree, configured in cvsweb.conf
+if ($input{'cvsroot'} && $CVSROOT{$input{'cvsroot'}}) {
+ $cvstree = $input{'cvsroot'};
+} else {
+ $cvstree = $cvstreedefault;
+}
+
+$cvsroot = $CVSROOT{$cvstree};
+
+# create icons out of description
+my $k;
+foreach $k (keys %ICONS) {
+ no strict 'refs';
+ my ($itxt, $ipath, $iwidth, $iheight) = @{$ICONS{$k}};
+ if ($ipath) {
+ ${"${k}icon"} =
+ sprintf(
+ '',
+ hrefquote($ipath), htmlquote($itxt), $iwidth, $iheight)
+ } else {
+ ${"${k}icon"} = $itxt;
+ }
+}
+undef $k;
+
+my $config_cvstree = "$config-$cvstree";
+
+# Do some special configuration for cvstrees
+if (-f $config_cvstree) {
+ do "$config_cvstree" or
+ fatal("500 Internal Error",
+ 'Error in loading configuration file: %s
The server on which the CVS tree lives is probably down. Please try again in a few minutes.');
}
-if (-d $fullname) {
-# Something that would be nice to support, although I have no real
-# good idea of how, would be to get full directory diff's, using
-# symbolic names (revision numbers would be meaningless).
-# The problem is finding a list of symbolic names that is common
-# to all the files in the directory.
+
#
- opendir(DIR, $fullname) || &fatal("404 Not Found","$where: $!");
- @dir = readdir(DIR);
- closedir(DIR);
- print "Content-type: text/html\n\n";
- print "
\n";
+ }
+ }
}
-sub link {
- local($name, $where) = @_;
+##
+# Function to generate Human readable diff-files
+# human_readable_diff(String revision_to_return_to);
+##
+sub human_readable_diff($) {
+ my ($difftxt, $where_nd, $filename, $pathname, $scriptwhere_nd);
+ my ($fh, $rev) = @_;
+ my ($date1, $date2, $r1d, $r2d, $r1r, $r2r, $rev1, $rev2, $sym1, $sym2);
+ my (@rightCol, @leftCol);
- "$name\n";
+ ($where_nd = $where) =~ s/.diff$//;
+ ($filename = $where_nd) =~ s/^.*\///;
+ ($pathname = $where_nd) =~ s/(Attic\/)?[^\/]*$//;
+ ($scriptwhere_nd = $scriptwhere) =~ s/.diff$//;
+
+ navigateHeader($scriptwhere_nd, $pathname, $filename, $rev, "diff");
+
+ # Read header to pick up read revision and date, if possible
+ while (<$fh>) {
+ ($r1d, $r1r) = /\t(.*)\t(.*)$/ if (/^--- /);
+ ($r2d, $r2r) = /\t(.*)\t(.*)$/ if (/^\+\+\+ /);
+ last if (/^\+\+\+ /);
+ }
+
+ if (defined($r1r) && $r1r =~ /^(\d+\.)+\d+$/) {
+ $rev1 = $r1r;
+ $date1 = $r1d;
+ }
+ if (defined($r2r) && $r2r =~ /^(\d+\.)+\d+$/) {
+ $rev2 = $r2r;
+ $date2 = $r2d;
+ }
+
+ print
+ "
Diff for /$where_nd between version $rev1 and $rev2
\n",
+ # Using style=\"border: none\" here breaks NS 4.x badly...
+ "
\n",
+ "
\n", "
",
+ "version $rev1";
+ print ", $date1" if (defined($date1));
+ print " Tag: $sym1\n" if ($sym1);
+ print "
\n", "
", "version $rev2";
+ print ", $date2" if (defined($date2));
+ print " Tag: $sym2\n" if ($sym1);
+ print "
\n";
+
+ my $leftRow = 0;
+ my $rightRow = 0;
+ my ($oldline, $newline, $funname, $diffcode, $rest);
+
+ # Process diff text
+
+ # prefetch several lines
+ my @buf = head($fh);
+
+ my %d = scan_directives(@buf);
+
+ while (@buf || !eof($fh)) {
+ $difftxt = @buf ? shift @buf : <$fh>;
+
+ if ($difftxt =~ /^@@/) {
+ ($oldline, $newline, $funname) =
+ $difftxt =~ /@@ \-([0-9]+).*\+([0-9]+).*@@(.*)/;
+ $funname = htmlquote($funname);
+ $funname =~ s/\s/ /go;
+ print
+ "
\n
";
+ print
+ "
\n
\n
Line $oldline";
+ print
+ " $funname
\n
\n
";
+ print "
\n
";
+ print
+ "
\n
\n
Line $newline";
+ print
+ " $funname
\n
\n
\n";
+ print "
\n";
+ $state = "dump";
+ $leftRow = 0;
+ $rightRow = 0;
+ } else {
+ ($diffcode, $rest) = $difftxt =~ /^([-+ ])(.*)/;
+ $_ = spacedHtmlText($rest, $d{'tabstop'});
+
+ #########
+ # little state machine to parse unified-diff output (Hen, zeller@think.de)
+ # in order to get some nice 'ediff'-mode output
+ # states:
+ # "dump" - just dump the value
+ # "PreChangeRemove" - we began with '-' .. so this could be the start of a 'change' area or just remove
+ # "PreChange" - okey, we got several '-' lines and moved to '+' lines -> this is a change block
+ ##########
+
+ if ($diffcode eq '+') {
+ if ($state eq "dump")
+ { # 'change' never begins with '+': just dump out value
+ print
+ "
";
+}
+
+sub plural_write($$) {
+ my ($num, $text) = @_;
+ if ($num != 1) {
+ $text .= "s";
+ }
+
+ if ($num > 0) {
+ return join (' ', $num, $text);
+ } else {
+ return "";
+ }
+}
+
+##
+# print readable timestamp in terms of
+# '..time ago'
+# H. Zeller
+##
+sub readableTime($$) {
+ my ($i, $break, $retval);
+ my ($secs, $long) = @_;
+
+ # this function works correct for time >= 2 seconds
+ if ($secs < 2) {
+ return "very little time";
+ }
+
+ my %desc = (
+ 1, 'second', 60, 'minute', 3600, 'hour',
+ 86400, 'day', 604800, 'week', 2628000, 'month',
+ 31536000, 'year'
+ );
+ my @breaks = sort { $a <=> $b } keys %desc;
+ $i = 0;
+
+ while ($i <= $#breaks && $secs >= 2 * $breaks[$i]) {
+ $i++;
+ }
+ $i--;
+ $break = $breaks[$i];
+ $retval = plural_write(int($secs / $break), $desc{$break});
+
+ if ($long == 1 && $i > 0) {
+ my $rest = $secs % $break;
+ $i--;
+ $break = $breaks[$i];
+ my $resttime = plural_write(int($rest / $break), $desc{$break});
+ if ($resttime) {
+ $retval .= ", $resttime";
+ }
+ }
+
+ return $retval;
+}
+
+##
+# clickablePath(String pathname, boolean last_item_clickable)
+#
+# returns a html-ified path whereas each directory is a link for
+# faster navigation. last_item_clickable controls whether the
+# basename (last directory/file) is a link as well
+##
+sub clickablePath($$) {
+ my ($pathname, $clickLast) = @_;
+ my $retval = '';
+
+ if ($pathname eq '/') {
+
+ # this should never happen - chooseCVSRoot() is
+ # intended to do this
+ $retval = "[$cvstree]";
+ } else {
+ $retval .= ' ' . &link("[$cvstree]",
+ sprintf('%s/%s#dirlist', $scriptname, $query));
+ my $wherepath = '';
+ my ($lastslash) = $pathname =~ m|/$|;
+
+ foreach (split (/\//, $pathname)) {
+ $retval .= " / ";
+ $wherepath .= "/$_";
+ my ($last) = "$wherepath/" eq "/$pathname"
+ || $wherepath eq "/$pathname";
+
+ if ($clickLast || !$last) {
+ $retval .= &link($_,
+ join ('', $scriptname,
+ urlencode($wherepath),
+ (!$last || $lastslash ? '/' : ''),
+ $query,
+ (!$last || $lastslash ? "#dirlist" : "")
+ ));
+ } else { # do not make a link to the current dir
+ $retval .= $_;
+ }
+ }
+ }
+ return $retval;
+}
+
+sub chooseCVSRoot() {
+
+ print "
";
+ }
+ print "\n";
+}
+
+sub chooseMirror() {
+
+ # 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.
+ scalar(%MIRRORS) or return;
+
+ # Should perhaps exclude the current site somehow...
+ print "\n
\nThis CVSweb is mirrored in\n";
+
+ my @tmp = map(&link(htmlquote($_), $MIRRORS{$_}),
+ sort keys %MIRRORS);
+ my $tmp = pop(@tmp);
+
+ if (scalar(@tmp)) {
+ print join(', ', @tmp), ' and ';
+ }
+
+ print "$tmp.\n
\n";
+}
+
+sub fileSortCmp() {
+ my ($comp) = 0;
+ my ($c, $d, $af, $bf);
+
+ ($af = $a) =~ s/,v$//;
+ ($bf = $b) =~ s/,v$//;
+ my ($rev1, $date1, $log1, $author1, $filename1) = @{$fileinfo{$af}}
+ if (defined($fileinfo{$af}));
+ my ($rev2, $date2, $log2, $author2, $filename2) = @{$fileinfo{$bf}}
+ if (defined($fileinfo{$bf}));
+
+ if (defined($filename1) && defined($filename2) && $af eq $filename1
+ && $bf eq $filename2)
+ {
+
+ # Two files
+ $comp = -revcmp($rev1, $rev2) if ($byrev && $rev1 && $rev2);
+ $comp = ($date2 <=> $date1) if ($bydate && $date1 && $date2);
+ $comp = ($log1 cmp $log2) if ($bylog && $log1 && $log2);
+ $comp = ($author1 cmp $author2)
+ if ($byauthor && $author1 && $author2);
+ }
+
+ if ($comp == 0) {
+
+ # Directories first, then files under version control,
+ # then other, "rogue" files.
+ # Sort by filename if no other criteria available.
+
+ 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");
+ }
+ return $comp;
+}
+
+# make A url for downloading
+sub download_url($$;$) {
+ my ($url, $revision, $mimetype) = @_;
+
+ $revision =~ s/\b0\.//;
+
+ if (defined($checkoutMagic)
+ && (!defined($mimetype) || $mimetype ne "text/x-cvsweb-markup"))
+ {
+ my $path = $where;
+ $path =~ s|[^/]+$||;
+ $url = "$scriptname/$checkoutMagic/${path}$url";
+ }
+ $url .= "?rev=$revision";
+ $url .= '&content-type=' . urlencode($mimetype) if (defined($mimetype));
+
+ $url;
+}
+
+# Presents a link to download the
+# selected revision
+sub download_link($$$;$) {
+ my ($url, $revision, $textlink, $mimetype) = @_;
+ my ($fullurl) = download_url($url, $revision, $mimetype);
+
+ $fullurl =~ s/:/sprintf("%%%02x", ord($&))/eg;
+
+ printf '$textlink";
+}
+
+# Returns a Query string with the
+# specified parameter toggled
+sub toggleQuery($$) {
+ my ($toggle, $value) = @_;
+ my ($newquery, $var);
+ my (%vars);
+ %vars = %input;
+
+ if (defined($value)) {
+ $vars{$toggle} = $value;
+ } else {
+ $vars{$toggle} = $vars{$toggle} ? 0 : 1;
+ }
+
+ # Build a new query of non-default paramenters
+ $newquery = "";
+ foreach $var (@stickyvars) {
+ my ($value) = defined($vars{$var}) ? $vars{$var} : "";
+ my ($default) =
+ defined($DEFAULTVALUE{$var}) ? $DEFAULTVALUE{$var} : "";
+
+ if ($value ne $default) {
+ $newquery .= "&" if ($newquery ne "");
+ $newquery .= urlencode($var) . "=" . urlencode($value);
+ }
+ }
+
+ if ($newquery) {
+ return '?' . $newquery;
+ }
+ return "";
+}
+
+sub urlencode($) {
+ local ($_) = @_;
+
+ s/[\000-+{-\377]/sprintf("%%%02x", ord($&))/ge;
+
+ $_;
+}
+
+sub htmlquote($) {
+ local ($_) = @_;
+
+ # Special Characters; RFC 1866
+ s/&/&/g;
+ s/\"/"/g;
+ s/</g;
+ s/>/>/g;
+
+ $_;
+}
+
+sub htmlunquote($) {
+ local ($_) = @_;
+
+ # Special Characters; RFC 1866
+ s/"/\"/g;
+ s/<//g;
+ s/&/&/g;
+
+ $_;
+}
+
+sub hrefquote($) {
+ local ($_) = @_;
+
+ y/ /+/;
+
+ htmlquote($_)
+}
+
+sub http_header(;$) {
+ my $content_type = shift || "text/html";
+
+ $content_type .= "; charset=$charset"
+ if $content_type =~ m,^text/, && defined($charset) && $charset;
+
+ if (defined($moddate)) {
+ if ($is_mod_perl) {
+ Apache->request->header_out(
+ "Last-Modified" => scalar gmtime($moddate)
+ . " GMT");
+ } else {
+ print "Last-Modified: ", scalar gmtime($moddate),
+ " GMT\r\n";
+ }
+ }
+
+ if ($is_mod_perl) {
+ Apache->request->content_type($content_type);
+ } else {
+ print "Content-Type: $content_type\r\n";
+ }
+
+ if ($allow_compress && $maycompress) {
+ if ($has_zlib
+ || (defined($CMD{gzip}) && open(GZIP, "| $CMD{gzip} -1 -c"))
+ )
+ {
+
+ if ($is_mod_perl) {
+ Apache->request->content_encoding("x-gzip");
+ Apache->request->header_out(
+ Vary => "Accept-Encoding");
+ Apache->request->send_http_header;
+ } else {
+ print "Content-Encoding: x-gzip\r\n";
+ print "Vary: Accept-Encoding\r\n"
+ ; #RFC 2068, 14.43
+ print "\r\n"; # Close headers
+ }
+ $| = 1;
+ $| = 0; # Flush header output
+
+ if ($has_zlib) {
+ tie *GZIP, __PACKAGE__, \*STDOUT;
+ }
+ select(GZIP);
+ $gzip_open = 1;
+
+ # print "" if ($content_type =~ m|^text/html\b|);
+ } else {
+ if ($is_mod_perl) {
+ Apache->request->send_http_header;
+ } else {
+ print "\r\n"; # Close headers
+ }
+ print
+ "Unable to find gzip binary in the \$command_path ($command_path) to compress output ";
+ }
+ } else {
+
+ if ($is_mod_perl) {
+ Apache->request->send_http_header;
+ } else {
+ print "\r\n"; # Close headers
+ }
+ }
+}
+
+sub html_header($) {
+ my ($title) = @_;
+ http_header("text/html");
+
+ (my $header = &cgi_style::html_header) =~ s,\A.*\n,,s;
+
+ print <
+
+$title
+$HTML_META
+$header
+EOH
+}
+
+sub html_footer() {
+ return &cgi_style::html_footer;
+}
+
+sub link_tags($) {
+ my ($tags) = @_;
+ my ($ret) = "";
+ my ($fileurl, $filename);
+
+ ($filename = $where) =~ s/^.*\///;
+ $fileurl = './' . urlencode($filename);
+
+ foreach my $sym (split (", ", $tags)) {
+ $ret .= ",\n" if ($ret ne "");
+ $ret .=
+ &link($sym, $fileurl . toggleQuery('only_with_tag', $sym));
+ }
+ return "$ret\n";
+}
+
+#
+# See if a module is listed in the config file's @HideModules list.
+#
+sub forbidden_module($) {
+ my ($module) = @_;
+ local $_;
+
+ for (@HideModules) {
+ return 1 if $module =~ $_;
+ }
return 0;
}
-sub fatal {
- local($errcode, $errmsg) = @_;
- print "Status: $errcode\n";
- print "Content-type: text/html\n";
- print "\n";
- print "Error\n";
- print "Error: $errmsg\n";
- exit(1);
+sub forbidden_file($) {
+ my ($path) = @_;
+ $path = substr($path, length($cvsroot) + 1);
+ local $_;
+ for (@ForbiddenFiles) {
+ return 1 if $path =~ $_;
+ }
+ return 0;
+}
+
+# Close the GZIP handle remove the tie.
+
+sub gzipclose {
+ if ($gzip_open) {
+ select(STDOUT);
+ close(GZIP);
+ untie *GZIP;
+ $gzip_open = 0;
+ }
+}
+
+# implement a gzipped file handle via the Compress:Zlib compression
+# library.
+
+sub MAGIC1() { 0x1f }
+sub MAGIC2() { 0x8b }
+sub OSCODE() { 3 }
+
+sub TIEHANDLE {
+ my ($class, $out) = @_;
+ my ($d) = Compress::Zlib::deflateInit(
+ -Level => Compress::Zlib::Z_BEST_COMPRESSION(),
+ -WindowBits => -Compress::Zlib::MAX_WBITS()
+ ) or return undef;
+ my ($o) = {
+ handle => $out,
+ dh => $d,
+ crc => 0,
+ len => 0,
+ };
+ my ($header) =
+ pack("c10", MAGIC1, MAGIC2, Compress::Zlib::Z_DEFLATED(), 0, 0, 0,
+ 0, 0, 0, OSCODE);
+ print {$o->{handle}} $header;
+ return bless($o, $class);
+}
+
+sub PRINT {
+ my ($o) = shift;
+ my ($buf) = join (defined $, ? $, : "", @_);
+ my ($len) = length($buf);
+ my ($compressed, $status) = $o->{dh}->deflate($buf);
+ print {$o->{handle}} $compressed if defined($compressed);
+ $o->{crc} = Compress::Zlib::crc32($buf, $o->{crc});
+ $o->{len} += $len;
+ return $len;
+}
+
+sub PRINTF {
+ my ($o) = shift;
+ my ($fmt) = shift;
+ my ($buf) = sprintf($fmt, @_);
+ my ($len) = length($buf);
+ my ($compressed, $status) = $o->{dh}->deflate($buf);
+ print {$o->{handle}} $compressed if defined($compressed);
+ $o->{crc} = Compress::Zlib::crc32($buf, $o->{crc});
+ $o->{len} += $len;
+ return $len;
+}
+
+sub WRITE {
+ my ($o, $buf, $len, $off) = @_;
+ my ($compressed, $status) = $o->{dh}->deflate(substr($buf, 0, $len));
+ print {$o->{handle}} $compressed if defined($compressed);
+ $o->{crc} = Compress::Zlib::crc32(substr($buf, 0, $len), $o->{crc});
+ $o->{len} += $len;
+ return $len;
+}
+
+sub CLOSE {
+ my ($o) = @_;
+ return if !defined($o->{dh});
+ my ($buf) = $o->{dh}->flush();
+ $buf .= pack("V V", $o->{crc}, $o->{len});
+ print {$o->{handle}} $buf;
+ undef $o->{dh};
+}
+
+sub DESTROY {
+ my ($o) = @_;
+ CLOSE($o);
}