===================================================================
RCS file: /cvs/cvsweb/cvsweb.cgi,v
retrieving revision 1.24
retrieving revision 4.18
diff -u -p -r1.24 -r4.18
--- cvsweb/cvsweb.cgi 1998/08/16 13:45:12 1.24
+++ cvsweb/cvsweb.cgi 2019/11/11 14:37:54 4.18
@@ -1,10 +1,29 @@
-#!/usr/bin/perl -s
+#!/usr/bin/perl
+# $Id: cvsweb.cgi,v 4.18 2019/11/11 14:37:54 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 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|\.zip)$/);
+ my ($basedir) = ($module =~ m,([^/]+)$,);
+
+ if ($basedir eq '' || $module eq '') {
+ fatal('500 Internal Error',
+ 'You cannot download the top level directory.');
+ }
+
+ my $istar = ($ext eq '.tar.gz' || $ext eq '.tgz');
+ if ($istar) {
+ fatal('500 Internal Error', 'tar command not found.') unless $CMD{tar};
+ fatal('500 Internal Error', 'gzip command not found.') unless $CMD{gzip};
+ }
+ my $iszip = ($ext eq '.zip');
+ if ($iszip && !$CMD{zip}) {
+ fatal('500 Internal Error', 'zip command not found.');
+ }
+ if (!$istar && !$iszip) {
+ fatal('500 Internal Error', '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: \n";
+ while ( Current directory: ', clickablePath($where, 0), '';
+ if ($cvshistory_url) {
+ (my $d = $where) =~ s|^/*(.*?)/*$|$1|;
+ print ' - ', history_link($d, '');
+ }
+ print " Current tag: ", htmlquote($input{only_with_tag}), "%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 : 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);
+
#
-# $fId: cvsweb.cgi,v 1.23 1998/08/15 09:59:11 wosch Exp $
+# Load configuration.
#
+if (-f $config) {
+ do "$config" or config_error($config, $@);
+} else {
+ fatal("500 Internal Error",
+ 'Configuration not found. Set the parameter $config
in cvsweb.cgi to your cvsweb.conf configuration file first.');
+}
+# 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));
+ }
+}
-#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
+$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
+
#
-require 'timelocal.pl';
-require 'ctime.pl';
+# 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;
+ $cvstreedefault = $key unless defined($cvstreedefault);
+ $CVSROOTdescr{$key} = $descr;
+ $CVSROOT{$key} = $root;
+ push(@CVSROOT, $key);
+}
+unless ($rootfound) {
+ fatal('500 Internal Error',
+ 'No valid CVS roots found! See @CVSrepositories
in ' .
+ 'the configuration file (%s
).',
+ $config);
+}
+undef $rootfound;
-$hsty_base = "";
-require 'cgi-style.pl';
-#&get_the_source;
+#
+# Default CVS root
+#
+if (!defined($CVSROOT{$cvstreedefault})) {
+ fatal("500 Internal Error",
+ '$cvstreedefault
points to a repository (%s) not ' .
+ 'defined in @CVSrepositories
in your configuration ' .
+ 'file (%s
).',
+ $cvstreedefault,
+ $config);
+}
-%CVSROOT = (
- 'freebsd', '/home/ncvs',
- 'learn', '/c/learncvs',
- 'mozilla', '/a/mozilla-cvs',
- );
+$DEFAULTVALUE{cvsroot} = $cvstreedefault;
-%CVSROOTdescr = (
- 'freebsd', 'FreeBSD',
- 'learn', 'Learn',
- 'mozilla', 'Mozilla FreeBSD',
- );
+while (my ($key, $defval) = each %DEFAULTVALUE) {
-%mirrors = (
- 'Germany', 'http://www.de.freebsd.org/cgi/cvsweb.cgi',
- 'Japan', 'http://www.jp.freebsd.org/www.freebsd.org/cgi/cvsweb.cgi',
- );
+ # Replace not given parameters with defaults.
+ next unless (defined($defval) && $defval =~ /\S/ && !defined($input{$key}));
-$cvstreedefault = 'freebsd';
-$cvstree = $cvstreedefault;
-$cvsroot = $CVSROOT{"$cvstree"} || "/home/ncvs";
+ # 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');
-$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.
+ } 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{$_})));
+ }
+}
+
+if ($allow_enscript) {
+ push(@DIFFTYPES, qw(uc cc));
+ @DIFFTYPES{qw(uc cc)} = (
+ {
+ 'descr' => 'unified, colored',
+ 'opts' => ['-u'],
+ 'colored' => 0,
+ },
+ {
+ 'descr' => 'context, colored',
+ 'opts' => ['-c'],
+ 'colored' => 0,
+ },
+ );
+} else {
+ # No Enscript -> respect difftype, but don't offer colorization.
+ if ($input{f} && $input{f} =~ /^([ucs])c$/) {
+ $input{f} = $1;
+ }
+}
+
+# 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 = $cvstreedefault;
+}
+
+$cvsroot = $CVSROOT{$cvstree};
+
+# create icons out of description
+foreach my $k (keys %ICONS) {
+ my ($itxt, $ipath, $iwidth, $iheight) = @{$ICONS{$k}};
+ no strict 'refs';
+ if ($ipath) {
+ ${"${k}icon"} =
+ sprintf('',
+ htmlquote($ipath), htmlquote($itxt), $iwidth, $iheight);
+ } else {
+ ${"${k}icon"} = $itxt;
+ }
+}
+
+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
%s
',
+ $config_cvstree, $@);
+}
+undef $config_cvstree;
+
+$re_prcategories = '(?:' . join ('|', @prcategories) . ')' if @prcategories;
+$re_prkeyword = quotemeta($prkeyword) if defined($prkeyword);
+$prcgi .= '%s' if defined($prcgi) && $prcgi !~ /%s/;
+
+$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!%s
',
+ $errcode, $err || $export_err);
+
+ } else {
+
+ $| = 1; # Essential to get the buffering right.
+ local (*TAR_OUT);
+
+ my (@cmd, $ctype);
+ if ($istar) {
+ my @tar = ($CMD{tar}, @tar_options, '-cf', '-', $basedir);
+ my @gzip = ($CMD{gzip}, @gzip_options, '-c');
+ push(@cmd, \@tar, '|', \@gzip);
+ $ctype = 'application/x-gzip';
+ } elsif ($iszip) {
+ my @zip = ($CMD{zip}, @zip_options, '-r', '-', $basedir);
+ push(@cmd, \@zip, \'');
+ $ctype = 'application/zip';
+ }
+ push(@cmd, '>pipe', \*TAR_OUT);
+
+ my ($h, $err) = startproc(@cmd);
+ if ($h) {
+ print "Content-Type: $ctype\r\n\r\n";
+ local $/ = undef;
+ print %s
',
+ $istar ? 'Tar' : 'Zip', $? >> 8 || -1, $err);
+ }
+ }
+
+ # Clean up.
+ chdir("..");
+ rmtree($tmpexportdir);
+
+ &fatal(@fatal) if @fatal;
+
+ exit;
+}
+
+##############################
+# View a directory
+###############################
+if (-d $fullname) {
+
+ 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);
+ $long_intro =~ s/!!CVSROOTdescr!!/$CVSROOTdescr{$cvstree}/g;
+ print $long_intro;
+ } 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
';
+ }
+ print "
\n";
+
+ my $infocols = 1;
+
+ printf(<
+EOF
+ printf(' \n";
+
+ my $dirrow = 0;
+
+ my $i;
+ lookingforattic:
+ for ($i = 0; $i <= $#dir; $i++) {
+ if ($dir[$i] eq "Attic") {
+ last lookingforattic;
+ }
+ }
+
+ if (!$input{hideattic}
+ && ($i <= $#dir)
+ && opendir($dh, $fullname . '/Attic'))
+ {
+ splice(@dir, $i, 1, grep((s|^|Attic/|, !m|/\.|), readdir($dh)));
+ closedir($dh);
+ }
+
+ my $hideAtticToggleLink =
+ $input{hideattic}
+ ? ''
+ : &link('[hide]', sprintf('./%s#dirlist', &toggleQuery('hideattic')));
+
+ # Sort without the Attic/ pathname.
+ # place directories first
+
+ my $filesexists;
+ my $filesfound;
+
+ foreach my $file (sort { &fileSortCmp } @dir) {
+
+ next if ($file eq curdir());
+
+ # ignore CVS lock and stale NFS files
+ next if ($file =~ /^\#cvs\.|^,|^\.nfs/); # \# for XEmacs cperl-mode...
+
+ # Check whether to show the CVSROOT path
+ next if ($input{hidecvsroot} && $where eq '/' && $file eq 'CVSROOT');
+
+ # Is it a directory?
+ my $isdir = -d catdir($fullname, $file);
+
+ # Ignore non-readable files and directories?
+ next if ($input{hidenonreadable} && (! -r _ || ($isdir && ! -x _)));
+
+ my $attic = '';
+ if ($file =~ s|^Attic/||) {
+ $attic = ' (in the Attic) ' .
+ $hideAtticToggleLink . '';
+ }
+
+ if ($file eq updir() || $isdir) {
+ next if ($file eq updir() && $where eq '/');
+ my ($rev, $date, $log, $author, $filename, $keywordsubst) =
+ @{$fileinfo{$file}} if (defined($fileinfo{$file}));
+ printf "', ($byfile ? ' class="sorted"' : ''));
+
+ if ($byfile) {
+ print 'File';
+ } else {
+ print &link('File',
+ sprintf('./%s#dirlist', toggleQuery('sortby', 'file')));
+ }
+ print " \n";
+
+ # Do not display the other column headers if we do not have any files
+ # with revision information.
+ if (scalar(%fileinfo)) {
+ $infocols++;
+ printf('', ($byrev ? ' class="sorted"' : ''));
+
+ if ($byrev) {
+ print 'Rev.';
+ } else {
+ print &link('Rev.',
+ sprintf('./%s#dirlist', toggleQuery('sortby', 'rev')));
+ }
+ print " \n";
+ $infocols++;
+ printf('', ($bydate ? ' class="sorted"' : ''));
+
+ if ($bydate) {
+ print 'Age';
+ } else {
+ print &link('Age',
+ sprintf('./%s#dirlist', toggleQuery('sortby', 'date')));
+ }
+ print " \n";
+
+ if ($show_author) {
+ $infocols++;
+ printf('', ($byauthor ? ' class="sorted"' : ''));
+
+ if ($byauthor) {
+ print 'Author';
+ } else {
+ print
+ &link('Author',
+ sprintf('./%s#dirlist', toggleQuery('sortby', 'author')));
+ }
+ print " \n";
+ }
+ $infocols++;
+ printf('', ($bylog ? ' class="sorted"' : ''));
+
+ if ($bylog) {
+ print 'Last log entry';
+ } else {
+ print &link('Last log entry',
+ sprintf('./%s#dirlist', toggleQuery('sortby', 'log')));
+ }
+ print " \n";
+ } elsif ($use_descriptions) {
+ print "Description \n";
+ $infocols++;
+ }
+ print "\n \n";
+ $dirrow++;
+
+ } elsif ($file =~ s/,v$//) {
+
+ my $fileurl = ($attic ? 'Attic/' : '') . uri_escape_path($file);
+ my $url = './' . $fileurl . $query;
+ $filesexists++;
+ next if (!defined($fileinfo{$file}));
+ my ($rev, $date, $log, $author, $filename, $keywordsubst) =
+ @{$fileinfo{$file}};
+ my $isbinary = $keywordsubst eq 'b' ? 1 : 0;
+ $filesfound++;
+
+ printf "",
+ ($dirrow % 2) ? 'even' : 'odd';
+
+ if ($file eq updir()) {
+ my $url = "../$query";
+ print $nofilelinks ? $backicon : &link($backicon, $url);
+ print ' ', &link("Parent Directory", $url);
+
+ } else {
+ my $url = './' . uri_escape_path($file) . "/$query";
+ print '';
+ print $nofilelinks ? $diricon : &link($diricon, $url);
+ print ' ', &link(htmlquote("$file/"), $url), $attic;
+ if ($file eq "Attic") {
+ print ' ',
+ &link('[show]',
+ sprintf('./%s#dirlist', &toggleQuery('hideattic'))),
+ '';
+ }
+ }
+
+ # Show last change in dir
+ if ($filename) {
+ my $ageclass = 'age';
+ my $age = '';
+ if ($date) {
+ $age = readableTime(time() - $date, 0);
+ $ageclass .= " $1" if ($age =~ /^\d+ ([a-z]+)/);
+ }
+ print " \n \n$age";
+ print " \n", htmlquote($author)
+ if $show_author;
+ print " \n";
+ $filename =~ s%^[^/]+/%%;
+ print &link(htmlquote("$filename/$rev"),
+ sprintf('%s/%s%s#rev%s',
+ uri_escape($file), uri_escape($filename),
+ $query, $rev)), '
';
+ if ($log) {
+ print htmlify(substr($log, 0, $shortLogLen), $allow_dir_extra);
+ print '...' if (length($log) > 80);
+ }
+
+ } else {
+ my $dwhere = ($where ne '/' ? $where : '') . $file;
+
+ if ($use_descriptions && defined $descriptions{$dwhere}) {
+ print '';
+ 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 " \n ";
+ $cols--;
+ }
+ }
+ }
+
+ print " \n\n", ($dirrow % 2) ? 'even' : 'odd';
+ printf ' ";
+ $dirrow++;
+ }
+ print "\n";
+ }
+
+ print "\n";
+
+ if ((my $num = scalar(@unreadable)) && ! $input{hidenonreadable}) {
+ printf(<';
+
+ my $icon = $isbinary ? $binfileicon : $fileicon;
+ print $nofilelinks ? $icon : &link($icon, $url);
+ print ' ', &link(htmlquote($file), $url), $attic;
+ print " \n", display_link($fileurl, $rev);
+ my $ageclass = 'age';
+ my $age = '';
+ if ($date) {
+ $age = readableTime(time() - $date, 0);
+ $ageclass .= " $1" if ($age =~ /^\d+ ([a-z]+)/);
+ }
+ print " \n$age";
+ print " \n", htmlquote($author) if $show_author;
+ print " \n";
+
+ if ($log) {
+ print htmlify(substr($log, 0, $shortLogLen), $allow_dir_extra);
+ print '...' if (length $log > 80);
+ }
+ print " \n
+ %s
+
The server on which the CVS tree lives is probably down. Please try again in a few minutes.'); +## End MAIN + + +sub printDiffSelect() +{ + print '"; } +sub printDiffSelectStickyVars() { - local(@foo, $i); - local($scriptname) = $ENV{'SCRIPT_NAME'}; - foreach (sort keys %CVSROOT) { - if (-d $CVSROOT{$_}) { - push(@foo, $_); - } + 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 '"; +} + + +# +# Find the last modified, version controlled files in the given directories. +# Compares solely based on modification timestamps. Files in the returned list +# are without the ,v suffix, and unreadable files have been filtered out. +# +sub findLastModifiedSubdirs(@) +{ + my (@dirs) = @_; + + my @files; + foreach my $dirname (@dirs) { + next if ($dirname eq curdir() || $dirname eq updir()); + my $dir = catdir($fullname, $dirname); + next if (!-d $dir); + + my $dh = do { local (*DH); }; + opendir($dh, $dir) or next; + my (@filenames) = grep(!forbidden(catfile($dir, $_)), readdir($dh)); + closedir($dh); + + my $lastmod = undef; + my $lastmodtime = undef; + foreach my $filename (@filenames) { + ($filename) = + (catfile($dirname, $filename) =~ VALID_PATH) or next; # untaint + my ($file) = catfile($fullname, $filename); + next if ($filename !~ /,v$/o || !-f $file || !-r _); + my $modtime = -M _; + if (!defined($lastmod) || $modtime < $lastmodtime) { + ($lastmod = $filename) =~ s/,v$//; + $lastmodtime = $modtime; + } } - if ($#foo > 1) { - $intro .= "
\nThis script support the following CVS trees:\n"; - for($i = 0; $i <= $#foo; $i++) { - $intro .= qq{} . - ($CVSROOTdescr{$foo[$i]} ? - $CVSROOTdescr{$foo[$i]} : $foo[$i]) . qq{} . - ($i == $#foo ? ".\n" : ",\n"); - } + push(@files, $lastmod) if (defined($lastmod)); + } + return @files; +} + + +sub htmlify_sub(&$) +{ + (my $proc, local $_) = @_; + my @a = split(m|(]+>[^<]*)|i); + my $linked; + my $result = ''; + + while (($_, $linked) = splice(@a, 0, 2)) { + &$proc(); + $result .= $_ if defined($_); + $result .= $linked if defined($linked); + } + + return $result; +} + + +sub htmlify($;$) +{ + (local $_, my $extra) = @_; + + $_ = htmlquote($_); + + # get URL's as link + s{ + ((https?|ftp)://.+?)([\s\']|&(quot|[lg]t);) + }{ + &link($1, htmlunquote($1)) . $3 + }egx; + + if ($allow_mailtos) { + # Make mailto: links from email addresses. + $_ = htmlify_sub { + s< + ([\w+=\-.!]+@[\w\-]+(?:\.[\w\-]+)+) + >< + &link($1, "mailto:$1") + >egix; + } $_; + } + + if ($extra) { + + # get PR #'s as link: "PR#nnnn" "PR: nnnn, ..." "PR nnnn, ..." "bin/nnnn" + if (defined($prcgi) && defined($re_prkeyword)) { + my $prev; + + do { + $prev = $_; + $_ = htmlify_sub { + s{ + (\b$re_prkeyword[:\#]?\s* + (?: + \#? + \d+[,\s]\s* + )* + \#?) + (\d+)\b + }{ + $1 . &link($2, sprintf($prcgi, $2)) + }egix; + } $_; + } while ($_ ne $prev); + + if (defined($re_prcategories)) { + $_ = htmlify_sub { + s{ + (\b$re_prcategories/(\d+)\b) + }{ + &link($1, sprintf($prcgi, $2)) + }egox; + } $_; + } } + + # get manpage specs as link: "foo.1" "foo(1)" + if (defined($mancgi)) { + $_ = htmlify_sub { + s{ + ( + \b ( \w[\w+\-.]* (?: ::\w[\w+\-.]*)* ) + (?: + \( ([0-9n]) \) \B + | + \. ([0-9n]) \b + ) + ) + }{ + my($text, $name, $section) = ($1, $2, defined($3) ? $3 : $4); + ($name =~ /[A-Za-z]/ && $name !~ /\.(:|$)/) + ? &link($text, sprintf($mancgi, uri_escape($name), $section)) + : $text; + }egx; + } $_; + } + } + + return $_; } +sub spacedHtmlText($;$) { - local(@mirrors) = sort keys %mirrors;; - if ($#mirrors >= 0) { - $intro .= "
\nThis script is mirrored in:\n"; - local($m); - for($m = 0; $m <= $#mirrors; $m++) { - $intro .= qq($mirrors[$m]); - $intro .= ',' if $m != $#mirrors; - $intro .= "\n"; - } + (local $_, my $ts) = @_; + return '' unless defined($_); + $ts ||= $tabstop || 8; + + # Expand tabs + 1 while s/(.*?)(\t+)/$1 . ' ' x (length($2) * $ts - length($1) % $ts)/e; + + if ($hr_breakable) { + s/^ /\001nbsp;/; # protect leading and... + s/ $/\001nbsp;/; # ...trailing whitespace (mostly for String::Ediff), + s/ / \001nbsp;/g; # ...and leave every other space 'breakable' + } else { + s/ /\001nbsp;/g; + } + + $_ = htmlify($_, $allow_source_extra); + + # unescape + y/\001/&/; + + return $_; +} + + +# Note that this doesn't htmlquote the first argument... +sub link($$) +{ + my ($name, $url) = @_; + return sprintf('%s', htmlquote($url), $name); +} + + +sub revcmp($$) +{ + my ($rev1, $rev2) = @_; + + # make no comparison for a tag or a branch + return 0 if $rev1 =~ /[^\d.]/ || $rev2 =~ /[^\d.]/; + + my (@r1) = split(/\./, $rev1); + my (@r2) = split(/\./, $rev2); + my ($a, $b); + + while (($a = shift(@r1)) && ($b = shift(@r2))) { + return $a <=> $b unless ($a == $b); + } + if (@r1) { return 1; } + if (@r2) { return -1; } + return 0; +} + + +# +# Signal a fatal error. +# +sub fatal($$@) +{ + my ($errcode, $format, @args) = @_; + print "Status: $errcode\r\n"; + html_header('Error'); + print '
%s
":This document has moved ", &link('here', $url), ".
\n"; + html_footer(); + exit(1); +} + + +sub safeglob($) +{ + my ($filename) = @_; + + (my $dirname = $filename) =~ s|/[^/]+$||; + $filename =~ s|.*/||; + + my @results; + my $dh = do { local (*DH); }; + if (opendir($dh, $dirname)) { + my $glob = $filename; + my $t; + + # transform filename from glob to regex. Deal with: + # [, {, ?, * as glob chars + # make sure to escape all other regex chars + $glob =~ s/([\.\(\)\|\+])/\\$1/g; + $glob =~ s/\*/.*/g; + $glob =~ s/\?/./g; + $glob =~ s/{([^}]+)}/($t = $1) =~ s-,-|-g; "($t)"/eg; + $glob = qr/^$glob$/; + + foreach (readdir($dh)) { + if ($_ =~ $glob && $_ =~ VALID_PATH) { + push(@results, catfile($dirname, $1)); # untaint + } } + closedir($dh); + } + + return @results; } -if (-d $fullname) { - opendir(DIR, $fullname) || &fatal("404 Not Found","$where: $!"); - @dir = readdir(DIR); - closedir(DIR); - if ($where eq '') { - print &html_header("FreeBSD CVS Repository"); - print $intro; - } else { - print &html_header("/$where"); - print $shortinstr; - } - print "";
- print "Current CVS tree: ",
- ($CVSROOTdescr{"$cvstree"} ? $CVSROOTdescr{"$cvstree"} :
- $cvstree), "
\n";
- print "Current directory: /$where\n";
- print "