===================================================================
RCS file: /cvs/cvsweb/cvsweb.cgi,v
retrieving revision 1.1.1.28
retrieving revision 4.8
diff -u -p -r1.1.1.28 -r4.8
--- cvsweb/cvsweb.cgi 2001/08/01 10:24:01 1.1.1.28
+++ cvsweb/cvsweb.cgi 2019/11/09 09:41:07 4.8
@@ -1,15 +1,19 @@
-#!/usr/bin/perl -wT
+#!/usr/bin/perl
+# $Id: cvsweb.cgi,v 4.8 2019/11/09 09:41:07 schwarze Exp $
+# $knu: cvsweb.cgi,v 1.299 2010/11/13 16:37:18 simon
#
# cvsweb - a CGI interface to CVS trees.
#
# 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
+# Bill Fenner (original work)
+# extended by Henner Zeller ,
+# Henrik Nordstrom
+# Ken Coar
+# Dick Balaska
+# Akinori MUSHA
+# Jens-Uwe Mager
+# Ville Skyttä
+# Vassilii Khachaturov
#
# Based on:
# * Bill Fenners cvsweb.cgi revision 1.28 available from:
@@ -17,8 +21,9 @@
#
# Copyright (c) 1996-1998 Bill Fenner
# (c) 1998-1999 Henner Zeller
-# (c) 1999 Henrik Nordstrom
-# (c) 2000-2001 Akinori MUSHA
+# (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
@@ -41,57 +46,101 @@
# 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.
-#
-# $zId: cvsweb.cgi,v 1.112 2001/07/24 13:03:16 hzeller Exp $
-# $Idaemons: /home/cvs/cvsweb/cvsweb.cgi,v 1.82 2001/08/01 09:54:52 knu Exp $
-#
-###
-require 5.000;
+require 5.006;
use strict;
+use warnings;
+use filetest qw(access);
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
- %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 $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 $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
+ $VERSION $CheckoutMagic $MimeTypes $DEBUG
+ $config $allow_version_select
+ @CVSrepositories @CVSROOT %CVSROOT %CVSROOTdescr
+ %MIRRORS %DEFAULTVALUE %ICONS %MTYPES
+ %DIFF_COMMANDS @DIFFTYPES %DIFFTYPES @LOGSORTKEYS %LOGSORTKEYS
+ %alltags %fileinfo %tags @branchnames %nameprinted
+ %symrev %revsym @allrevisions %date %author @revdisplayorder
+ @revisions %state %difflines %log %branchpoint @revorder $keywordsubstitution
+ $prcgi @prcategories $re_prcategories $prkeyword $re_prkeyword $mancgi
+ $doCheckout $scriptname $scriptwhere
+ $where $Browser $nofilelinks $maycompress @stickyvars
+ $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
+ $charset $output_filter
+ @command_path %CMD $allow_compress $backicon $diricon $fileicon $graphicon
+ $fullname $cvstreedefault $logo $defaulttitle $address $binfileicon
+ $long_intro $short_instruction $shortLogLen $show_author
+ $tablepadding $hr_breakable $showfunc $hr_ignwhite $hr_ignkeysubst
+ $inputTextSize $mime_types $allow_annotate $allow_markup $allow_mailtos
+ $allow_log_extra $allow_dir_extra $allow_source_extra
+ $allow_cvsgraph $cvsgraph_config $use_java_script $edit_option_form
+ $show_subdir_lastmod $show_log_in_markup $preformat_in_markup
+ $tabstop $state $annTable $sel @ForbiddenFiles
+ $use_descriptions %descriptions @mytz $dwhere
+ $use_moddate $gzip_open $file_list_len
+ $allow_tar @tar_options @gzip_options @zip_options @cvs_options
+ @annotate_options @rcsdiff_options
+ $HTML_DOCTYPE $HTML_META $cssurl $CSS $cvshistory_url
+ $allow_enscript @enscript_options %enscript_types
);
+use Cwd qw(abs_path);
+use File::Path qw(rmtree);
+use File::Spec::Functions qw(canonpath catdir catfile curdir devnull rootdir
+ tmpdir updir);
+use File::Temp qw(tempdir tempfile);
+use IPC::Run qw();
+use Time::Local qw(timegm);
+use URI::Escape qw(uri_escape uri_unescape);
+
+use constant VALID_PATH => qr/^([[:^cntrl:]]+)$/o;
+use constant VALID_TAG1 => qr/^([a-zA-Z][[:graph:]]*)$/o;
+use constant VALID_TAG2 => qr/^([^\$,.:;@]+)$/o;
+use constant CVSWEBMARKUP => qr{^text/(x-cvsweb|vnd\.viewcvs)-markup$}io;
+use constant LOG_FILESEPR => qr/^={77}$/o;
+use constant LOG_REVSEPR => qr/^-{28}$/o;
+
+use constant HAS_ZLIB => eval { require Compress::Zlib; };
+use constant HAS_EDIFF => eval { require String::Ediff; };
+
+# -----------------------------------------------------------------------------
+
+# All global initialization that can be done in compile time should go to
+# the BEGIN block. Persistent environments, such as mod_perl, will benefit
+# from this.
+
+BEGIN
+{
+ $VERSION = '3.1';
+
+ $HTML_DOCTYPE =
+ '';
+
+ $HTML_META = <
+
+
+
+EOM
+
+ # Use MIME::Types for MIME type lookups if it's available.
+ eval {
+ require MIME::Types;
+ $MimeTypes = MIME::Types->new(only_complete => 1);
+ };
+ $MimeTypes = undef if $@;
+
+ $CheckoutMagic = '~checkout~';
+}
+
+# -----------------------------------------------------------------------------
+
sub printDiffSelect($);
-sub printDiffLinks($$);
+sub printDiffSelectStickyVars();
+sub getDiffLinks($$$);
sub printLogSortSelect($);
sub findLastModifiedSubdirs(@);
sub htmlify_sub(&$);
@@ -99,25 +148,31 @@ sub htmlify($;$);
sub spacedHtmlText($;$);
sub link($$);
sub revcmp($$);
-sub fatal($$);
-sub redirect($);
+sub fatal($$@);
+sub config_error($$);
+sub redirect($;$);
sub safeglob($);
sub search_path($);
-sub getMimeTypeFromSuffix($);
+sub getEnscriptHL($);
+sub getMimeType($;$);
sub head($;$);
sub scan_directives(@);
+sub openOutputFilter();
sub doAnnotate($$);
-sub doCheckout($$);
-sub cvswebMarkup($$$);
+sub doCheckout($$$);
+sub doEnscript($$$;$);
+sub doGraph();
+sub doGraphView();
+sub cvswebMarkup($$$$$$;$);
sub viewable($);
sub doDiff($$$$$$);
sub getDirLogs($$@);
sub readLog($;$);
-sub printLog($;$);
+sub printLog($$$;$$);
sub doLog($);
sub flush_diff_rows($$$$);
-sub human_readable_diff($);
-sub navigateHeader($$$$$);
+sub human_readable_diff($$);
+sub navigateHeader($$$$$;$);
sub plural_write($$);
sub readableTime($$);
sub clickablePath($$);
@@ -126,148 +181,119 @@ sub chooseMirror();
sub fileSortCmp();
sub download_url($$;$);
sub download_link($$$;$);
-sub toggleQuery($$);
-sub urlencode($);
+sub display_url($$;$);
+sub display_link($$;$$);
+sub graph_link($;$);
+sub history_link($$;$);
+sub toggleQuery($;$);
sub htmlquote($);
sub htmlunquote($);
-sub hrefquote($);
-sub http_header(;$);
-sub html_header($);
+sub uri_escape_path($);
+sub http_header(;$$);
+sub html_header($;$);
sub html_footer();
sub link_tags($);
-sub forbidden_file($);
-sub forbidden_module($);
+sub forbidden($);
+sub startproc(@);
+sub runproc(@);
+sub checkout_to_temp($$$);
-##### Start of Configuration Area ########
-delete $ENV{PATH};
+# Get rid of unsafe environment vars. Don't do this in the BEGIN block
+# (think mod_perl)...
+delete(@ENV{qw(PATH IFS CDPATH ENV BASH_ENV)});
-$cvsweb_revision =
- '1.112' . '.' . (
- split (/ /,
- q$Idaemons: /home/cvs/cvsweb/cvsweb.cgi,v 1.82 2001/08/01 09:54:52 knu Exp $
-))[2];
+# Location of the configuration file inside the web server chroot:
+$config = '/conf/cvsweb/cvsweb.conf';
-use File::Basename;
+######## Configuration parameters #########
-($mydir) = (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;
-
-##### 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 = undef;
-$tmpdir = defined($ENV{TMPDIR}) ? $ENV{TMPDIR} : "/var/tmp";
+ %MTYPES = %tags = %alltags = %fileinfo = %DIFF_COMMANDS = ();
-$LOG_FILESEPARATOR = q/^={77}$/;
-$LOG_REVSEPARATOR = q/^-{28}$/;
+$cvstreedefault = $logo = $defaulttitle =
+ $address = $long_intro = $short_instruction = $shortLogLen = $show_author =
+ $tablepadding = $hr_breakable = $showfunc = $hr_ignwhite =
+ $hr_ignkeysubst = $inputTextSize = $mime_types = $allow_annotate =
+ $allow_markup = $allow_compress = $use_java_script = $edit_option_form =
+ $show_subdir_lastmod = $show_log_in_markup = $preformat_in_markup =
+ $tabstop = $use_moddate = $gzip_open = $DEBUG = $allow_cvsgraph =
+ $cvsgraph_config = $cvshistory_url = $allow_tar = undef;
-@DIFFTYPES = qw(h H u c s);
+$allow_version_select = $allow_mailtos = $allow_log_extra = 1;
+
+@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,
- },
- {
- 'descr' => 'side by side',
- 'opts' => ['--side-by-side', '--width=164'],
- 'colored' => 0,
- },
+ {
+ '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',
- },
+ { descr => 'Not sorted', },
+ { descr => 'Commit date', },
+ { descr => 'Revision', },
);
-##### End of configuration variables #####
+##### End of configuration parameters #####
-use Time::Local;
-use IPC::Open2;
+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});
+}
-# 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 = !$@;
+$scriptname = '' unless defined($scriptname);
-$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|^/*|/|;
+$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$//;
+ $pathinfo .= '/';
+ my $re = quotemeta $pathinfo;
+ $scriptname =~ s/$re$//;
}
-$scriptwhere = $scriptname;
-$scriptwhere .= '/' . urlencode($where);
-$where = '/' if ($where eq '');
+# $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 '');
-$is_mod_perl = defined($ENV{MOD_PERL});
+# In text-based browsers, it's very annoying to have two links per file;
+# skip linking the image for them.
-# 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 `);
+$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`);
@@ -286,3270 +312,4100 @@ $nofilelinks = $is_textbased;
# 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));
+$maycompress = (
+ ((defined($ENV{HTTP_ACCEPT_ENCODING})
+ && $ENV{HTTP_ACCEPT_ENCODING} =~ /gzip/)
+ || $is_mozilla3)
+ && !$is_msie
+ && !(defined($ENV{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);
+# 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);
+#
+# Load configuration.
+#
if (-f $config) {
- require $config || &fatal(
- "500 Internal Error",
- sprintf(
- 'Error in loading configuration file: %s %s ',
- $config,
- &htmlify($@)
- )
- );
+ do "$config" or config_error($config, $@);
} else {
- &fatal("500 Internal Error",
- 'Configuration not found. Set the variable $config
'
- . 'in cvsweb.cgi to your cvsweb.conf configuration file first.'
- );
+ 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));
+ }
+}
+
+$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);
+ $val = 1 unless defined($val);
+ ($key = uri_unescape($key)) =~ /[[:graph:]]/ or next;
+ ($val = uri_unescape($val)) =~ /[[:graph:]]/ or next;
+ $query{$key} = $val;
+ }
+}
+
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{$_}++;
- }
- }
+my $t;
+for my $p (qw(graph hideattic hidecvsroot hidenonreadable ignorecase ln copt
+ makeimage 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);
-# 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}));
+# --- end input parameters
-$DEFAULTVALUE{'cvsroot'} = $cvstreedefault;
+#
+# 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;
-foreach (keys %DEFAULTVALUE) {
+#
+# 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);
+}
- # replace not given parameters with the default parameters
- if (!defined($input{$_}) || $input{$_} eq "") {
+$DEFAULTVALUE{cvsroot} = $cvstreedefault;
- # 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"})) {
+while (my ($key, $defval) = each %DEFAULTVALUE) {
- # 'copt' isn't defined --> empty input is not the result
- # of empty input checkbox --> set default
- $input{$_} = $DEFAULTVALUE{$_}
- if (defined($DEFAULTVALUE{$_}));
- } else {
+ # Replace not given parameters with defaults.
+ next unless (defined($defval) && $defval =~ /\S/ && !defined($input{$key}));
- # '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"));
- }
- }
+ # 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{$_}) && $input{$_} ne ''
- && !(defined($DEFAULTVALUE{$_}) && $input{$_} eq $DEFAULTVALUE{$_}))
- {
- push @barequery,
- join ('=', urlencode($_), urlencode($input{$_}));
- }
+ # 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";
+ $barequery = join (';', @barequery);
+ $query = "?$barequery";
+ $barequery = ";$barequery";
} else {
- $query = "";
+ $query = "";
}
undef @barequery;
if (defined($input{path})) {
- redirect("$scriptname/$input{path}$query");
+ 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;
+{
+ 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'};
+$defaultDiffType = $input{f};
-$logsort = $input{'logsort'};
+$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;
-}
-undef @tmp;
-undef @pair;
-
-## Default CVS-Tree
-if (!defined($CVSROOT{$cvstreedefault})) {
- &fatal("500 Internal Error",
- "\$cvstreedefault
points to a repository ($cvstreedefault) "
- . "not defined in %CVSROOT
"
- . "(edit your configuration file $config)");
-}
-
# alternate CVS-Tree, configured in cvsweb.conf
-if ($input{'cvsroot'} && $CVSROOT{$input{'cvsroot'}}) {
- $cvstree = $input{'cvsroot'};
+if ($input{cvsroot} && $CVSROOT{$input{cvsroot}}) {
+ $cvstree = $input{cvsroot};
} else {
- $cvstree = $cvstreedefault;
+ $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;
- }
+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;
+ }
}
-undef $k;
my $config_cvstree = "$config-$cvstree";
# Do some special configuration for cvstrees
if (-f $config_cvstree) {
- require $config_cvstree || &fatal(
- "500 Internal Error",
- sprintf(
- 'Error in loading configuration file: %s %s ',
- $config_cvstree,
- &htmlify($@)
- )
- );
+ 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/;
+$re_prcategories = '(?:' . join ('|', @prcategories) . ')' if @prcategories;
+$re_prkeyword = quotemeta($prkeyword) if defined($prkeyword);
+$prcgi .= '%s' if defined($prcgi) && $prcgi !~ /%s/;
-$fullname = "$cvsroot/$where";
-$mimetype = &getMimeTypeFromSuffix($fullname);
-$defaultTextPlain = ($mimetype eq "text/plain");
-$defaultViewable = $allow_markup && viewable($mimetype);
+$fullname = catfile($cvsroot, $where);
my $rewrite = 0;
-
if ($pathinfo =~ m|//|) {
- $pathinfo =~ y|/|/|s;
- $rewrite = 1;
+ $pathinfo =~ y|/|/|s;
+ $rewrite = 1;
}
-
-if (-d $fullname && $pathinfo !~ m|/$|) {
- $pathinfo .= '/';
- $rewrite = 1;
+if (-d $fullname) {
+ if ($pathinfo !~ m|/$|) {
+ $pathinfo .= '/';
+ $rewrite = 1;
+ }
+} elsif ($pathinfo =~ m|/$|) {
+ chop $pathinfo;
+ $rewrite = 1;
}
-
-if (!-d $fullname && $pathinfo =~ m|/$|) {
- chop $pathinfo;
- $rewrite = 1;
-}
-
if ($rewrite) {
- redirect($scriptname . urlencode($pathinfo) . $query);
+ redirect($scriptname . uri_escape_path($pathinfo) . $query, 1);
}
-
undef $rewrite;
+undef $pathinfo;
+
if (!-d $cvsroot) {
- &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.'
- );
+ 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.');
}
#
-# See if the module is in our forbidden list.
+# 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.
#
-$where =~ m:([^/]*):;
-$module = $1;
-if ($module && &forbidden_module($module)) {
- &fatal("403 Forbidden", "Access to $where forbidden.");
-}
+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 =~ /(\.tar\.gz|\.zip)$/);
- my ($basedir) = ($module =~ m,([^/]+)$,);
+ fatal('403 Forbidden', 'Downloading tarballs is prohibited.')
+ unless $allow_tar;
- if ($basedir eq '' || $module eq '') {
- &fatal("500 Internal Error",
- "You cannot download the top level directory.");
- }
+ my ($module) = ($where =~ m,^/?(.*),); # untaint
+ $module =~ s,/([^/]*)$,,;
+ my ($ext) = ($1 =~ /(\.t(?:ar\.)?gz|\.zip)$/);
+ my ($basedir) = ($module =~ m,([^/]+)$,);
- my $tmpdir = "/tmp/.cvsweb.$$." . int(time);
+ if ($basedir eq '' || $module eq '') {
+ fatal('500 Internal Error',
+ 'You cannot download the top level directory.');
+ }
- mkdir($tmpdir, 0700)
- or &fatal("500 Internal Error",
- "Unable to make temporary 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 @fatal;
+ 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 $tag =
- (exists $input{only_with_tag} && length $input{only_with_tag}) ?
- $input{only_with_tag} : "HEAD";
+ my @fatal;
+ my $tag = $input{only_with_tag} || 'HEAD';
+ $tag = 'HEAD' if ($tag eq 'MAIN');
- if (system $CMD{cvs}, @cvs_options, '-Qd', $cvsroot, 'export', '-r',
- $tag, '-d', "$tmpdir/$basedir", $module)
- {
- @fatal = ("500 Internal Error", "cvs co failure: $!: $module");
- } else {
- $| = 1; # Essential to get the buffering right.
+ 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);
- if ($ext eq '.tar.gz') {
- print "Content-type: application/x-gzip\r\n\r\n";
+ } else {
- system
- "$CMD{tar} @tar_options -cf - -C $tmpdir $basedir | $CMD{gzip} @gzip_options -c"
- and @fatal =
- ("500 Internal Error",
- "tar zc failure: $!: $basedir");
- } elsif ($ext eq '.zip' && $CMD{zip}) {
- print "Content-type: application/zip\r\n\r\n";
+ $| = 1; # Essential to get the buffering right.
+ local (*TAR_OUT);
- system
- "cd $tmpdir && $CMD{zip} @zip_options -r - $basedir"
- and @fatal =
- ("500 Internal Error", "zip failure: $!: $basedir");
- } else {
- @fatal =
- ("500 Internal Error", "unsupported file type");
- }
- }
+ 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);
- system $CMD{rm}, '-rf', $tmpdir if -d $tmpdir;
+ my ($h, $err) = startproc(@cmd);
+ if ($h) {
+ print "Content-Type: $ctype\r\n\r\n";
+ local $/ = undef;
+ print ;
+ $h->finish();
+ } else {
+ @fatal = ('500 Internal Error',
+ '%s failure (exit status %s), output: %s ',
+ $istar ? 'Tar' : 'Zip', $? >> 8 || -1, $err);
+ }
+ }
- &fatal(@fatal) if @fatal;
+ # Clean up.
+ rmtree($tmpexportdir);
- exit;
+ &fatal(@fatal) if @fatal;
+
+ exit;
}
##############################
# View a directory
###############################
if (-d $fullname) {
- my $dh = do { local (*DH); };
- opendir($dh, $fullname) || &fatal("404 Not Found", "$where: $!");
- my @dir = readdir($dh);
- closedir($dh);
- my @subLevelFiles = findLastModifiedSubdirs(@dir)
- if ($show_subdir_lastmod);
- getDirLogs($cvsroot, $where, @subLevelFiles);
- if ($where eq '/') {
- html_header($defaulttitle);
- $long_intro =~ s/!!CVSROOTdescr!!/$CVSROOTdescr{$cvstree}/g;
- print $long_intro;
- } else {
- html_header($where);
- print $short_instruction;
- }
+ 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);
- my $descriptions;
- if (($use_descriptions) && open(DESC, "<$cvsroot/CVSROOT/descriptions"))
- {
- while () {
- chomp;
- my ($dir, $description) = /(\S+)\s+(.*)/;
- $descriptions{$dir} = $description;
- }
- }
+ 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 ;
+ } else {
+ print "\n";
+ while () {
+ chomp;
+ print htmlquote($_), ' ';
+ }
+ print "
";
+ }
+ $h->finish();
+ }
+ print $short_instruction;
+ }
- print " \n";
+ if ($use_descriptions &&
+ open(DESC, catfile($cvsroot, 'CVSROOT', 'descriptions'))) {
+ while () {
+ chomp;
+ my ($dir, $description) = /(\S+)\s+(.*)/;
+ $descriptions{$dir} = $description;
+ }
+ close(DESC);
+ }
- # give direct access to dirs
- if ($where eq '/') {
- chooseMirror ();
- chooseCVSRoot ();
- } else {
- print "Current directory: ", &clickablePath($where, 0),
- " \n";
+ print "
\n";
- print "Current tag: ", $input{only_with_tag}, " \n"
- if $input{only_with_tag};
+ # give direct access to dirs
+ if ($where eq '/') {
+ chooseMirror();
+ chooseCVSRoot();
- }
+ } else {
+ print '
Current directory: ', clickablePath($where, 0), ' ';
+ if ($cvshistory_url) {
+ (my $d = $where) =~ s|^/*(.*?)/*$|$1|;
+ print ' - ', history_link($d, '');
+ }
+ print "
\n";
+ print "Current tag: ", htmlquote($input{only_with_tag}), "
\n"
+ if $input{only_with_tag};
+ }
- print " \n";
+ print " \n";
- # Using in this manner violates the HTML2.0 spec but
- # provides the results that I want in most browsers. Another
- # case of layout spooging up HTML.
+ my $infocols = 1;
- my $infocols = 0;
- if ($dirtable) {
- if (defined($tableBorderColor)) {
+ printf(<
+
+EOF
+ printf('', ($byfile ? ' class="sorted"' : ''));
- # Can't this be done by defining the border for the inner table?
- print
- "";
- }
- print
- "\n";
- $infocols++;
- printf '',
- $byfile ? $columnHeaderColorSorted :
- $columnHeaderColorDefault;
+ if ($byfile) {
+ print 'File';
+ } else {
+ print &link('File',
+ sprintf('./%s#dirlist', toggleQuery('sortby', 'file')));
+ }
+ print " \n";
- if ($byfile) {
- print 'File';
- } else {
- print &link(
- 'File',
- sprintf(
- './%s#dirlist',
- &toggleQuery("sortby", "file")
- )
- );
- }
- print "";
+ # 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"' : ''));
- # do not display the other column-headers, if we do not have any files
- # with revision information:
- if (scalar(%fileinfo)) {
- $infocols++;
- printf ' ',
- $byrev ? $columnHeaderColorSorted :
- $columnHeaderColorDefault;
+ if ($byrev) {
+ print 'Rev.';
+ } else {
+ print &link('Rev.',
+ sprintf('./%s#dirlist', toggleQuery('sortby', 'rev')));
+ }
+ print " \n";
+ $infocols++;
+ printf('', ($bydate ? ' class="sorted"' : ''));
- if ($byrev) {
- print 'Rev.';
- } else {
- print &link(
- 'Rev.',
- sprintf(
- './%s#dirlist',
- &toggleQuery("sortby", "rev")
- )
- );
- }
- print " ";
- $infocols++;
- printf '',
- $bydate ? $columnHeaderColorSorted :
- $columnHeaderColorDefault;
+ if ($bydate) {
+ print 'Age';
+ } else {
+ print &link('Age',
+ sprintf('./%s#dirlist', toggleQuery('sortby', 'date')));
+ }
+ print " \n";
- if ($bydate) {
- print 'Age';
- } else {
- print &link(
- 'Age',
- sprintf(
- './%s#dirlist',
- &toggleQuery("sortby", "date")
- )
- );
- }
- print "";
+ if ($show_author) {
+ $infocols++;
+ printf('', ($byauthor ? ' class="sorted"' : ''));
- if ($show_author) {
- $infocols++;
- printf ' ',
- $byauthor ? $columnHeaderColorSorted :
- $columnHeaderColorDefault;
+ if ($byauthor) {
+ print 'Author';
+ } else {
+ print
+ &link('Author',
+ sprintf('./%s#dirlist', toggleQuery('sortby', 'author')));
+ }
+ print " \n";
+ }
+ $infocols++;
+ printf('', ($bylog ? ' class="sorted"' : ''));
- if ($byauthor) {
- print 'Author';
- } else {
- print &link(
- 'Author',
- sprintf(
- './%s#dirlist',
- &toggleQuery(
- "sortby",
- "author"
- )
- )
- );
- }
- print " ";
- }
- $infocols++;
- printf '',
- $bylog ? $columnHeaderColorSorted :
- $columnHeaderColorDefault;
+ 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";
- if ($bylog) {
- print 'Last log entry';
- } else {
- print &link(
- 'Last log entry',
- sprintf(
- './%s#dirlist',
- &toggleQuery("sortby", "log")
- )
- );
- }
- print "";
- } elsif ($use_descriptions) {
- printf '',
- $columnHeaderColorDefault;
- print "Description";
- $infocols++;
- }
- print "\n";
- } else {
- print "\n";
- }
- my $dirrow = 0;
+ my $dirrow = 0;
- my $i;
- lookingforattic:
- for ($i = 0 ; $i <= $#dir ; $i++) {
- if ($dir[$i] eq "Attic") {
- last lookingforattic;
- }
- }
+ 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);
- }
+ 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")));
+ my $hideAtticToggleLink =
+ $input{hideattic}
+ ? ''
+ : &link('[hide]', sprintf('./%s#dirlist', &toggleQuery('hideattic')));
- # Sort without the Attic/ pathname.
- # place directories first
+ # Sort without the Attic/ pathname.
+ # place directories first
- my $attic;
- my $url;
- my $fileurl;
- my $filesexists;
- my $filesfound;
+ my $filesexists;
+ my $filesfound;
- foreach (sort { &fileSortCmp } @dir) {
- if ($_ eq '.') {
- next;
- }
+ foreach my $file (sort { &fileSortCmp } @dir) {
- # ignore CVS lock and stale NFS files
- next if (/^#cvs\.|^,|^\.nfs/);
+ next if ($file eq curdir());
- # Check whether to show the CVSROOT path
- next if ($input{'hidecvsroot'} && ($_ eq 'CVSROOT'));
+ # ignore CVS lock and stale NFS files
+ next if ($file =~ /^\#cvs\.|^,|^\.nfs/); # \# for XEmacs cperl-mode...
- # Check whether the module is in the restricted list
- next if ($_ && &forbidden_module($_));
+ # Check whether to show the CVSROOT path
+ next if ($input{hidecvsroot} && $where eq '/' && $file eq 'CVSROOT');
- # Ignore non-readable files
- next if ($input{'hidenonreadable'} && !(-r "$fullname/$_"));
+ # Is it a directory?
+ my $isdir = -d catdir($fullname, $file);
- if (s|^Attic/||) {
- $attic = " (in the Attic) " . $hideAtticToggleLink;
- } else {
- $attic = "";
- }
+ # Ignore non-readable files and directories?
+ next if ($input{hidenonreadable} && (! -r _ || ($isdir && ! -x _)));
- if ($_ eq '..' || -d "$fullname/$_") {
- next if ($_ eq '..' && $where eq '/');
- my ($rev, $date, $log, $author, $filename);
- ($rev, $date, $log, $author, $filename) =
- @{$fileinfo{$_}}
- if (defined($fileinfo{$_}));
- printf '', $tabcolors[$dirrow % 2]
- if $dirtable;
+ my $attic = '';
+ if ($file =~ s|^Attic/||) {
+ $attic = ' (in the Attic) ' .
+ $hideAtticToggleLink . ' ';
+ }
- if ($_ eq '..') {
- $url = "../$query";
- if ($nofilelinks) {
- print $backicon;
- } else {
- print &link($backicon, $url);
- }
- print " ", &link("Parent Directory", $url);
- } else {
- $url = './' . urlencode($_) . "/$query";
- print " ";
+ 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 " \n",
+ ($dirrow % 2) ? 'even' : 'odd';
- if ($nofilelinks) {
- print $diricon;
- } else {
- print &link($diricon, $url);
- }
- print " ", &link("$_/", $url), $attic;
+ if ($file eq updir()) {
+ my $url = "../$query";
+ print $nofilelinks ? $backicon : &link($backicon, $url);
+ print ' ', &link("Parent Directory", $url);
- if ($_ eq "Attic") {
- print " ";
- print &link(
- "[Don't hide]",
- sprintf(
- './%s#dirlist',
- &toggleQuery(
- "hideattic")
- )
- );
- }
- }
+ } 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) {
- print " "
- if ($dirtable);
- if ($date) {
- print " ",
- readableTime(time() - $date, 0),
- " ";
- }
+ # 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);
+ }
- if ($show_author) {
- print " " if ($dirtable);
- print $author;
- }
- print " " if ($dirtable);
- $filename =~ s%^[^/]+/%%;
- print "$filename/$rev";
- print " " if ($dirtable);
+ } else {
+ my $dwhere = ($where ne '/' ? $where : '') . $file;
- if ($log) {
- print " ", &htmlify(
- substr($log, 0, $shortLogLen));
- if (length $log > 80) {
- print "...";
- }
- print " ";
- }
- } else {
- my ($dwhere) =
- ($where ne "/" ? $where : "") . $_;
+ if ($use_descriptions && defined $descriptions{$dwhere}) {
+ print ' ';
+ print $descriptions{$dwhere};
- if ($use_descriptions
- && defined $descriptions{$dwhere})
- {
- print " "
- if $dirtable;
- print $descriptions{$dwhere};
- } elsif ($dirtable && $infocols > 1) {
+ } 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 " ";
- $cols--;
- }
- }
- }
+ # 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--;
+ }
+ }
+ }
- if ($dirtable) {
- print " \n";
- } else {
- print " \n";
- }
- $dirrow++;
- } elsif (s/,v$//) {
- $fileurl = ($attic ? "Attic/" : "") . urlencode($_);
- $url = './' . $fileurl . $query;
- my $rev = '';
- my $date = '';
- my $log = '';
- my $author = '';
- $filesexists++;
- next if (!defined($fileinfo{$_}));
- ($rev, $date, $log, $author) = @{$fileinfo{$_}};
- $filesfound++;
- printf '', $tabcolors[$dirrow % 2]
- if $dirtable;
- print " ";
+ print " \n \n";
+ $dirrow++;
- if ($nofilelinks) {
- print $fileicon;
- } else {
- print &link($fileicon, $url);
- }
- print " ", &link($_, $url), $attic;
- print " " if ($dirtable);
- download_link($fileurl, $rev, $rev,
- $defaultViewable ? "text/x-cvsweb-markup" :
- undef);
- print " " if ($dirtable);
+ } elsif ($file =~ s/,v$//) {
- if ($date) {
- print " ", readableTime(time() - $date, 0),
- " ";
- }
- if ($show_author) {
- print " " if ($dirtable);
- print $author;
- }
- print " " if ($dirtable);
+ 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++;
- if ($log) {
- print " ",
- &htmlify(substr($log, 0, $shortLogLen));
- if (length $log > 80) {
- print "...";
- }
- print " ";
- }
- print " " if ($dirtable);
- print(($dirtable) ? "" : " ");
- $dirrow++;
- }
- print "\n";
- }
+ printf "\n", ($dirrow % 2) ? 'even' : 'odd';
+ printf '', $allow_cvsgraph ? '' : ' colspan="2"';
- if ($dirtable && defined($tableBorderColor)) {
- print "
";
- }
- print($dirtable == 1 ? "
\n" : "\n");
+ my $icon = $isbinary ? $binfileicon : $fileicon;
+ print $nofilelinks ? $icon : &link($icon, $url);
+ print ' ', &link(htmlquote($file), $url), $attic;
+ print ' ', graph_link($fileurl) if $allow_cvsgraph;
+ 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 ($filesexists && !$filesfound) {
- print
- "NOTE: There are $filesexists files, but none matches the current tag ($input{only_with_tag})\n";
- }
- if ($input{only_with_tag} && (!%tags || !$tags{$input{only_with_tag}}))
- {
- %tags = %alltags
- }
+ if ($log) {
+ print htmlify(substr($log, 0, $shortLogLen), $allow_dir_extra);
+ print '...' if (length $log > 80);
+ }
+ print "
\n ";
+ $dirrow++;
+ }
+ print "\n";
+ }
- if (scalar %tags || $input{only_with_tag} || $edit_option_form
- || defined($input{"options"}))
- {
- print " ";
- }
+ print "\n";
- if (scalar %tags || $input{only_with_tag}) {
- print "
+EOF
+ }
- foreach my $tag (reverse sort { lc $a cmp lc $b } keys %tags) {
- print "$tag\n";
- }
- print "\n";
- print " Module path or alias:\n";
- printf " \n",
- htmlquote($where);
- print " \n";
- print "\n";
- }
+ 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 ($allow_tar) {
- my ($basefile) = ($where =~ m,(?:.*/)?([^/]+),);
+ if ($input{only_with_tag} && (!%tags || !$tags{$input{only_with_tag}})) {
+ %tags = %alltags;
+ }
- if (defined($basefile) && $basefile ne '') {
- print " \n",
- "Download this directory in ";
+ if (scalar %tags
+ || $input{only_with_tag}
+ || $edit_option_form
+ || defined($input{options}))
+ {
+ print "
\n";
+ }
- # Mangle the filename so browsers show a reasonable
- # filename to download.
- print &link("tarball", "./$basefile.tar.gz$query"
- . ($query ? "&" : "?") . "tarball=1");
- if ($CMD{zip}) {
- print " or ",
- &link("zip archive", "./$basefile.zip$query"
- . ($query ? "&" : "?") . "tarball=1");
- }
- print "";
- }
- }
+ if (scalar %tags || $input{only_with_tag}) {
+ print "
+EOF
+ }
- my $formwhere = $scriptwhere;
- $formwhere =~ s|Attic/?$|| if ($input{'hideattic'});
+ if ($allow_tar && $filesfound) {
+ my ($basefile) = ($where =~ m,(?:.*/)?([^/]+),);
+ my $havetar = $CMD{tar} && $CMD{gzip};
+ my $havezip = $CMD{zip};
+ if (defined($basefile) && $basefile ne '' && ($havetar || $havezip)) {
+ my $q = ($query ? "$query;" : '?') . 'tarball=1';
+ print " \n",
+ 'Download this directory in ';
+ # Mangle the filename so browsers show a reasonable filename to download.
+ my @types = ();
+ $basefile = uri_escape($basefile);
+ push(@types, &link('tarball', "$basefile.tar.gz$q")) if $havetar;
+ push(@types, &link('zip archive', "$basefile.zip$q")) if $havezip;
+ print join(' or ', @types), "
\n";
+ }
+ }
- if ($edit_option_form || defined($input{"options"})) {
- print "\n";
- }
- print &html_footer;
- print "