===================================================================
RCS file: /cvs/cvsweb/cvsweb.cgi,v
retrieving revision 1.1
retrieving revision 4.39
diff -u -p -r1.1 -r4.39
--- cvsweb/cvsweb.cgi 1996/09/28 23:31:06 1.1
+++ cvsweb/cvsweb.cgi 2019/11/29 23:42:40 4.39
@@ -1,526 +1,3831 @@
-#!/usr/bin/perl -s
+#!/usr/bin/perl
+# $Id: cvsweb.cgi,v 4.39 2019/11/29 23:42:40 schwarze Exp $
+# $knu: cvsweb.cgi,v 1.299 2010/11/13 16:37:18 simon
#
-# 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-2005 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.
-$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.
-
',
+ $config, $@;
+ fatal '500 Internal Error',
+ 'Cannot read configuration file "%s": %s',
+ $config, $! || 'unknown error';
+}
+
+######## other global variables #########
+
+@DIFFTYPES = qw(h H u c);
+@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,
+ },
+);
+
+@LOGSORTKEYS = qw(cvs date rev);
+@LOGSORTKEYS{@LOGSORTKEYS} = (
+ { descr => 'Not sorted', },
+ { descr => 'Commit date', },
+ { descr => 'Revision', },
+);
+
+%alltags = ();
+@CVSROOT = ();
+%CVSROOT = ();
+%CVSROOTdescr = ();
+%fileinfo = ();
+$gzip_open = 0;
+%tags = ();
+
+######## end of global variables #########
+
+my $pathinfo = '';
+if (defined($ENV{PATH_INFO}) && $ENV{PATH_INFO} ne '') {
+ ($pathinfo) = ($ENV{PATH_INFO} =~ VALID_PATH)
+ or fatal('500 Internal Error',
+ 'Illegal PATH_INFO in environment: %s',
+ $ENV{PATH_INFO});
+}
+if ($ENV{SCRIPT_NAME}) {
+ ($scriptname) = ($ENV{SCRIPT_NAME} =~ VALID_PATH)
+ or fatal('500 Internal Error',
+ 'Illegal SCRIPT_NAME in environment: %s',
+ $ENV{SCRIPT_NAME});
+}
+
+$scriptname = '' unless defined($scriptname);
+
+$where = $pathinfo;
+$doCheckout = $where =~ s|^/$CheckoutMagic/|/|o;
+$where =~ s|^/||;
+$scriptname =~ s|^/+||;
+
+# Let's workaround thttpd's stupidity..
+if ($scriptname =~ m|/$|) {
+ $pathinfo .= '/';
+ my $re = quotemeta $pathinfo;
+ $scriptname =~ s/$re$//;
+}
+$scriptname = "/$scriptname" if $scriptname;
+
+# $scriptname : the URI escaped path to this script
+# $where : the path in the CVS repository (without leading /, or only /)
+# $scriptwhere: the URI escaped $scriptname + '/' + $where
+$scriptname = uri_escape_path($scriptname);
+$scriptwhere = join('/', $scriptname, uri_escape_path($where));
+$where = '/' if ($where eq '');
+
+# In text-based browsers, it's very annoying to have two links per file;
+# skip linking the image for them.
+
+$Browser = $ENV{HTTP_USER_AGENT} || '';
+$is_links = ($Browser =~ m`^E?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} =~ /gzip/)
+ || $is_mozilla3)
+ && !$is_msie
+ && !(defined($ENV{MOD_PERL}))
+);
+
+# Parameters that will be sticky in all constructed links/query strings.
+@stickyvars =
+ qw(cvsroot hideattic ignorecase sortby logsort f only_with_tag ln
+ hidecvsroot hidenonreadable);
+
+# Try to find a readable dir where we can cd into. Some abs_path()
+# implementations as well as various cvs operations require such a dir to
+# work properly.
+{
+ local $^W = 0;
+ for my $dir (tmpdir(), rootdir()) {
+ last if (-r $dir && chdir($dir));
+ }
+}
+
+$CSS = $cssurl ?
+ sprintf("\n",
+ htmlquote($cssurl)) : '';
+
+# --- input parameters
+
+my %query = ();
+if (defined($ENV{QUERY_STRING})) {
+ for my $p (split(/[;&]+/, $ENV{QUERY_STRING})) {
+ next unless $p;
+ $p =~ y/+/ /;
+ my ($key, $val) = split(/=/, $p, 2);
+ next unless defined($key);
+ $key = uri_unescape($key);
+ $key =~ /([^a-z_12-])/ and fatal('404 Not Found',
+ 'Invalid character "%s" in query parameter "%s"', $1, $key);
+ if (defined $val) {
+ $val = uri_unescape($val);
+ $val =~ /([^a-zA-Z_01-9.\/-])/ and fatal('404 Not Found',
+ 'Invalid character "%s" in the value "%s" of the query parameter "%s"',
+ $1, $val, $key);
+ } else {
+ $val = 1;
+ }
+ $query{$key} = $val;
+ }
+}
+
+undef %input;
+
+my $t;
+for my $p (qw(hideattic hidecvsroot hidenonreadable ignorecase ln copt
+ options tarball)) {
+ $t = $query{$p};
+ if (defined($t)) {
+ ($input{$p}) = ($t =~ /^([01]|on)$/)
+ or fatal('500 Internal Error',
+ 'Invalid boolean value: %s=%s', $p, $t);
+ }
+}
+for my $p (qw(annotate r1 r2 rev tr1 tr2)) {
+ $t = $query{$p};
+ if (defined($t)) {
+ if (($p eq 'r1' || $p eq 'r2') && $t eq 'text') {
+ # Special case for the "Use text field" option in the log view diff form.
+ $input{$p} = $t;
+ next;
+ } elsif (($p eq 'rev' || $p eq 'annotate') && ($t eq '.' || $t eq 'HEAD')){
+ # Another special case, allow linking to latest revision using these.
+ $input{$p} = '.';
+ next;
+ }
+ my ($rev, $tag) = split(/:/, $t, 2);
+ ($input{$p}) = ($rev =~ /^(\d+(?:\.\d+)*)$/)
+ or fatal('500 Internal Error',
+ 'Invalid revision: %s=%s', $p, $t);
+ if (defined($tag)) {
+ ($tag) = ($tag =~ VALID_TAG1)
+ or fatal('500 Internal Error',
+ 'Invalid tag/branch name in revision: %s=%s',
+ $p, $t);
+ ($tag) = ($tag =~ VALID_TAG2)
+ or fatal('500 Internal Error',
+ 'Invalid tag/branch name in revision: %s=%s',
+ $p, $t);
+ $input{$p} .= ':' . $tag;
+ }
+ }
+}
+$t = defined($query{only_with_tag}) ?
+ $query{only_with_tag} : $query{only_on_branch}; # Backwards compatibility.
+if (defined($t)) {
+ ($input{only_with_tag}) = ($t =~ VALID_TAG1)
+ or fatal('500 Internal Error',
+ 'Invalid tag/branch name: %s', $t);
+ ($input{only_with_tag}) = ($t =~ VALID_TAG2)
+ or fatal('500 Internal Error',
+ 'Invalid tag/branch name: %s', $t);
+}
+$t = $query{logsort};
+if (defined($t)) {
+ ($input{logsort}) = ($t =~ /^(cvs|date|rev)$/)
+ or fatal('500 Internal Error',
+ 'Unsupported log sort key: %s', $t);
+}
+$t = $query{f};
+if (defined($t)) {
+ ($input{f}) = ($t =~ /^(([hH]|[ucs]c?)|ext\d*)$/)
+ or fatal('500 Internal Error',
+ 'Unsupported diff format: %s', $t);
+}
+$t = $query{sortby};
+if (defined($t)) {
+ ($input{sortby}) = ($t =~ /^(file|date|rev|author|log)$/)
+ or fatal('500 Internal Error',
+ 'Unsupported dir sort key: %s', $t);
+}
+$t = $query{'content-type'};
+if (defined($t)) {
+ ($input{'content-type'}) = ($t =~ m|^([-0-9A-Za-z]+/[-0-9A-Za-z\.\+]+)$|)
+ or fatal('500 Internal Error',
+ 'Unsupported content type: %s', $t);
+}
+$t = $query{cvsroot};
+if (defined($t)) {
+ ($input{cvsroot}) = ($t =~ /^([[:print:]]+)$/)
+ or fatal('500 Internal Error',
+ 'Invalid symbolic CVS root name: %s', $t);
+}
+$t = $query{path};
+if (defined($t)) {
+ ($input{path}) = ($t =~ VALID_PATH)
+ or fatal('500 Internal Error',
+ 'Invalid path: %s', $t);
+}
+undef($t);
+undef(%query);
+
+# --- end input parameters
+
+#
+# CVS roots
+#
+my $rootfound = 0;
+for (my $i = 0; $i < scalar(@CVSrepositories); $i += 2) {
+ my $key = $CVSrepositories[$i];
+ my ($descr, $root) = @{$CVSrepositories[$i+1]};
+ $root = canonpath($root);
+ unless (-d $root) {
+ warn("Root '$root' defined in \@CVSrepositories is not a directory, " .
+ 'entry ignored');
+ next;
+ }
+ $rootfound ||= 1;
+ $CVSROOTdescr{$key} = $descr;
+ $CVSROOT{$key} = $root;
+ push(@CVSROOT, $key);
+}
+unless ($rootfound) {
+ fatal('500 Internal Error', 'no valid CVS roots found');
+}
+undef $rootfound;
+
+$DEFAULTVALUE{cvsroot} = $CVSrepositories[0];
+
+while (my ($key, $defval) = each %DEFAULTVALUE) {
+
+ # Replace not given parameters with defaults.
+ next unless (defined($defval) && $defval =~ /\S/ && !defined($input{$key}));
+
+ # Empty checkboxes in forms return nothing, so we define a helper parameter
+ # in these forms (copt) which indicates that we just set parameters with a
+ # checkbox.
+ if ($input{copt}) {
+
+ # 'copt' is set -> the result of empty input checkbox
+ # -> set to zero (disable) if default is a boolean (0|1).
+ $input{$key} = 0 if ($defval eq '0' || $defval eq '1');
+
+ } else {
+
+ # 'copt' isn't set --> empty input is not the result
+ # of empty input checkbox --> set default.
+ $input{$key} = $defval;
+ }
+}
+
+$barequery = "";
+my @barequery;
+foreach (@stickyvars) {
+
+ # construct a query string with the sticky non default parameters set
+ if (defined($input{$_})
+ && !(defined($DEFAULTVALUE{$_}) && $input{$_} eq $DEFAULTVALUE{$_}))
+ {
+ push(@barequery, join('=', uri_escape($_), uri_escape($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
+{
+ my $sortby = $input{sortby} || 'file';
+ $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};
+
+# alternate CVS-Tree, configured in cvsweb.conf
+if ($input{cvsroot} && $CVSROOT{$input{cvsroot}}) {
+ $cvstree = $input{cvsroot};
+} else {
+ $cvstree = $CVSrepositories[0];
+}
+
+$cvsroot = $CVSROOT{$cvstree};
+
+if ($iconsdir) {
+ $backicon = '';
+ $diricon = '';
+ $fileicon = '';
+ $binfileicon = '';
+} else {
+ $backicon = 'back';
+ $diricon = 'dir';
+ $fileicon = 'file';
+ $binfileicon = 'binfile';
+}
+
+$fullname = catfile($cvsroot, $where);
+
+my $rewrite = 0;
+if ($pathinfo =~ m|//|) {
+ $pathinfo =~ y|/|/|s;
+ $rewrite = 1;
+}
+if (-d $fullname) {
+ if ($pathinfo !~ m|/$|) {
+ $pathinfo .= '/';
+ $rewrite = 1;
+ }
+} elsif ($pathinfo =~ m|/$|) {
+ chop $pathinfo;
+ $rewrite = 1;
+}
+if ($rewrite) {
+ redirect($scriptname . uri_escape_path($pathinfo) . $query, 1);
+}
+undef $rewrite;
+
+undef $pathinfo;
+
if (!-d $cvsroot) {
- &fatal("500 Internal Error",'$CVSROOT not found!');
+ fatal("500 Internal Error",
+ '$CVSROOT not found!
The server on which the CVS tree lives is probably down. Please try again in a few minutes.');
}
+
+#
+# Short-circuit forbidden things. Note that $fullname should not change
+# after this, because the rest of the code assumes this check has already
+# been done.
+#
+fatal('403 Forbidden', 'Access to %s forbidden.', $where)
+ if forbidden($fullname);
+
+#
+# Handle tarball downloads before any headers are output.
+#
+if ($input{tarball}) {
+ fatal('403 Forbidden', 'Downloading tarballs is prohibited.')
+ unless $allow_tar;
+
+ my ($module) = ($where =~ m,^/?(.*),); # untaint
+ $module =~ s,/([^/]*)$,,;
+ my ($ext) = ($1 =~ /(\.t(?:ar\.)?gz)$/);
+ my ($basedir) = ($module =~ m,([^/]+)$,);
+
+ if ($basedir eq '' || $module eq '') {
+ fatal('500 Internal Error',
+ 'You cannot download the top level directory.');
+ }
+
+ unless ($ext eq '.tar.gz' || $ext eq '.tgz') {
+ fatal('404 Not Found', 'Unsupported archive type.');
+ }
+
+ my $tmpexportdir;
+ eval {
+ local $SIG{__DIE__};
+ # Don't use the CLEANUP argument to tempdir() here, since we might be under
+ # mod_perl (the process runs for a long time), unlink explicitly later.
+ $tmpexportdir = tempdir('.cvsweb.XXXXXXXX', TMPDIR => 1);
+ };
+ if ($@) {
+ fatal('500 Internal Error', 'Unable to make temporary directory: %s', $@);
+ }
+ if (!chdir($tmpexportdir)) {
+ fatal('500 Internal Error',
+ "Can't cd to temporary directory %s: %s", $tmpexportdir, $!);
+ }
+
+ my @fatal;
+ my $tag = $input{only_with_tag} || 'HEAD';
+ $tag = 'HEAD' if ($tag eq 'MAIN');
+
+ my @cmd =
+ ($CMD{cvs}, @cvs_options, '-Qd', $cvsroot, 'export', '-r', $tag,
+ '-d', $basedir, $module);
+ my $export_err;
+ my ($errcode, $err) = runproc(\@cmd, '2>', \$export_err);
+ if ($errcode) {
+ @fatal =
+ ('500 Internal Error',
+ 'Export failure (exit status %s), output:
%s
',
+ $errcode, $err || $export_err);
+ } else {
+ $| = 1; # Essential to get the buffering right.
+ local (*TAR_OUT);
+ my ($h, $err) = startproc($CMD{tar}, @tar_options, '-czf', '-',
+ $basedir, '>pipe', \*TAR_OUT);
+ if ($h) {
+ print "Content-Type: application/x-gzip\r\n\r\n";
+ local $/ = undef;
+ print ;
+ $h->finish();
+ } else {
+ @fatal = ('500 Internal Error',
+ 'tar failure (exit status %s), output:
%s
',
+ $? >> 8 || -1, $err);
+ }
+ }
+
+ # Clean up.
+ chdir("..");
+ rmtree($tmpexportdir);
+
+ &fatal(@fatal) if @fatal;
+
+ exit;
+}
+
+##############################
+# View a directory
+###############################
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.
+
+ my $dh = do { local (*DH); };
+ opendir($dh, $fullname) or fatal("404 Not Found", '%s: %s', $where, $!);
+ my @dir = grep(!forbidden(catfile($fullname, $_)), readdir($dh));
+ closedir($dh);
+ my @subLevelFiles = findLastModifiedSubdirs(@dir) if $show_subdir_lastmod;
+ my @unreadable = getDirLogs($cvsroot, $where, @subLevelFiles);
+
+ if ($where eq '/') {
+ html_header($defaulttitle);
+ } else {
+ html_header($where);
+ my $html = (-f catfile($fullname, 'README.cvs.html,v') ||
+ -f catfile($fullname, 'Attic', 'README.cvs.html,v'));
+ my $text = (!$html &&
+ (-f catfile($fullname, 'README.cvs,v') ||
+ -f catfile($fullname, 'Attic', 'README.cvs,v')));
+ if ($html || $text) {
+ my $rev = $input{only_with_tag} || 'HEAD';
+ my $cr = abs_path($cvsroot) || $cvsroot;
+ my $co = "$where/README.cvs.html" if $html;
+ $co ||= "$where/README.cvs" if $text;
+ # abs_path() taints when run as a CGI...
+ if ($cr =~ VALID_PATH) {
+ $cr = $1;
+ } else {
+ fatal('500 Internal Error', 'Illegal CVS root: %s', $cr);
+ }
+ my @cmd = ($CMD{cvs}, @cvs_options, '-d', $cr, 'co', '-p', "-r$rev",$co);
+ local (*CVS_OUT, *CVS_ERR);
+ my ($h, $err) = startproc(\@cmd, \"", '>pipe', \*CVS_OUT,
+ '2>pipe', \*CVS_ERR);
+ fatal('500 Internal Error', $err) unless $h;
+ if ($html) {
+ local $/ = undef;
+ print ;
+ } else {
+ print "
\n";
+
+ # Do not display the other column headers if we do not have any files
+ # with revision information.
+ if (scalar(%fileinfo)) {
+ $infocols++;
+ printf('
';
+ print $descriptions{$dwhere};
+
+ } elsif ($infocols > 1) {
+
+ # close the row with the appropriate number of
+ # columns, so that the vertical seperators are visible
+ my ($cols) = $infocols;
+ while ($cols > 1) {
+ print "
";
+ $dirrow++;
+ }
+ print "\n";
+ }
+
+ print "\n";
+
+ if ((my $num = scalar(@unreadable)) && ! $input{hidenonreadable}) {
+ printf(<
+ NOTE: The following %d unreadable files were ignored:
+ %s
+
+EOF
+ }
+
+ if ($filesexists && !$filesfound) {
+ my $currtag = defined($input{only_with_tag}) ?
+ sprintf(' (%s)', htmlquote($input{only_with_tag})) : '';
+ printf(<
+ NOTE: There are %d files, but none matches the current tag%s.
+
+EOF
+ }
+
+ if ($input{only_with_tag} && (!%tags || !$tags{$input{only_with_tag}})) {
+ %tags = %alltags;
+ }
+
+ if (scalar %tags
+ || $input{only_with_tag}
+ || $edit_option_form
+ || defined($input{options}))
+ {
+ print "\n";
+ }
+
+ if (scalar %tags || $input{only_with_tag}) {
+ print "
+EOF
+ }
+
+ if ($allow_tar && $filesfound) {
+ my ($basefile) = ($where =~ m,(?:.*/)?([^/]+),);
+ if (defined($basefile) && $basefile ne '') {
+ my $q = ($query ? "$query;" : '?') . 'tarball=1';
+ print "\n",
+ '
Download this directory in ';
+ # Mangle the filename so browsers show a reasonable filename to download.
+ $basefile = uri_escape($basefile);
+ print &link('tarball', "$basefile.tar.gz$q");
+ print "
\n";
+ }
+ }
+
+ if ($edit_option_form || defined($input{options})) {
+
+ print <
+
+
+EOF
+ }
+ html_footer();
+}
+
+###############################
+# View Files
+###############################
+elsif (-f $fullname . ',v') {
+
+ if (defined($input{rev}) || $doCheckout) {
+ &doCheckout($fullname, $input{rev}, $input{only_with_tag});
+ gzipclose();
+ exit;
+ }
+
+ if (defined($input{annotate}) && $allow_annotate) {
+ &doAnnotate($input{annotate}, $input{only_with_tag});
+ gzipclose();
+ exit;
+ }
+
+ if (defined($input{r1}) && defined($input{r2})) {
+ &doDiff($fullname, $input{r1}, $input{tr1},
+ $input{r2}, $input{tr2}, $input{f});
+ gzipclose();
+ exit;
+ }
+
+ &doLog($fullname);
+}
+
+##############################
+# View Diff
+##############################
+elsif ($fullname =~ s/\.diff$//
+ && -f $fullname . ',v' && $input{r1} && $input{r2})
+{
+
+ # $where-diff-removal if 'cvs rdiff' is used
+ # .. but 'cvs rdiff'doesn't support some options
+ # rcsdiff does (-w and -p), so it is disabled
+ # $where =~ s/\.diff$//;
+
+ # Allow diffs using the ".diff" extension so that browsers that default
+ # to the filename in the URL when saving don't save diffs as eg. foo.c.
+ &doDiff($fullname, $input{r1}, $input{tr1},
+ $input{r2}, $input{tr2}, $input{f});
+ gzipclose();
+ exit;
+
+}
+
+elsif (do { (my $tmp = $fullname) =~ s|/([^/]+)$|/Attic/$1|; -f "$tmp,v" }) {
+ # The file has been removed and is in the Attic.
+ # Send a redirect pointing to the file in the Attic.
+ (my $newplace = $scriptwhere) =~ s|/([^/]+)$|/Attic/$1|;
+ if ($ENV{QUERY_STRING} ne "") {
+ redirect("$newplace?$ENV{QUERY_STRING}");
+ } else {
+ redirect($newplace);
+ }
+ exit;
+
+}
+
+elsif (0 && (my @files = &safeglob($fullname . ",v"))) {
+ http_header("text/plain");
+ print "You matched the following files:\n";
+ print join ("\n", @files);
+
+ # TODO:
+ # Find the tags from each file
+ # Display a form offering diffs between said tags
+}
+
+else {
+ # Assume it's a module name with a potential path following it.
+ my $module;
+ my $xtra = (($module = $where) =~ s|(/.*)||) ? $1 : '';
+
+ # Is there an indexed version of modules?
+ my $fh = do { local (*FH); };
+ if (open($fh, catfile($cvsroot, 'CVSROOT', 'modules'))) {
+ while (<$fh>) {
+ if (/^(\S+)\s+(\S+)/o
+ && $module eq $1
+ && $module ne $2
+ && -d "$cvsroot/$2")
+ {
+ close($fh);
+ redirect("$scriptname/$2$xtra$query");
+ }
+ }
+ close($fh);
+ }
+ fatal("404 Not Found", '%s: no such file or directory', $where);
+}
+
+gzipclose();
+
+## End MAIN
+
+
+sub printDiffSelect()
+{
+ print '";
+}
+
+
+sub printDiffSelectStickyVars()
+{
+ while (my ($key, $val) = each %input) {
+ next if ($key eq 'f');
+ next if (defined($DEFAULTVALUE{$key}) && $DEFAULTVALUE{$key} eq $val);
+ print "\n";
+ }
+}
+
+
+sub printLogSortSelect()
+{
+ print '";
+}
+
+
#
- opendir(DIR, $fullname) || &fatal("404 Not Found","$where: $!");
- @dir = readdir(DIR);
- closedir(DIR);
- print "Content-type: text/html\n\n";
- print "FreeBSD CVS Tree: /$where\n";
- print "\n";
- print "