%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});
+}
-##### End of configuration variables #####
+$scriptname = '' unless defined($scriptname);
-use Time::Local ();
-use IPC::Open2 qw(open2);
+$where = $pathinfo;
+$doCheckout = $where =~ s|^/$CheckoutMagic/|/|o;
+$where =~ s|^/||;
+$scriptname =~ s|^/+||;
-# Check if the zlib C library interface is installed, and if yes
-# we can avoid using the extra gzip process.
-eval { require Compress::Zlib; };
-$has_zlib = !$@;
-
-$verbose = $v;
-$checkoutMagic = "~checkout~";
-$pathinfo = defined($ENV{PATH_INFO}) ? $ENV{PATH_INFO} : '';
-$where = $pathinfo;
-$doCheckout = ($where =~ m|^/$checkoutMagic/|);
-$where =~ s|^/$checkoutMagic/|/|;
-$where =~ s|^/||;
-$scriptname = defined($ENV{SCRIPT_NAME}) ? $ENV{SCRIPT_NAME} : '';
-$scriptname =~ s|^/*|/|;
-
# Let's workaround thttpd's stupidity..
if ($scriptname =~ m|/$|) {
- $pathinfo .= '/';
- my $re = quotemeta $pathinfo;
- $scriptname =~ s/$re$//;
+ $pathinfo .= '/';
+ my $re = quotemeta $pathinfo;
+ $scriptname =~ s/$re$//;
}
+$scriptname = "/$scriptname" if $scriptname;
-$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`);
@@ -301,811 +301,896 @@ $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}))
+);
-# put here the variables we need in order
-# to hold our state - they will be added (with
-# their current value) to any link/query string
-# you construct
-@stickyvars = qw(cvsroot hideattic sortby logsort f only_with_tag);
-@unsafevars = qw(logsort only_with_tag r1 r2 rev sortby tr1 tr2);
+# 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);
-if (-f $config) {
- do "$config" or fatal("500 Internal Error",
- 'Error in loading configuration file: %s$config
in cvsweb.cgi to your cvsweb.conf configuration file first.'
- );
+# Load configuration.
+{
+ $config =~ m|^/| or fatal '500 Internal Error',
+ 'Configuration file name "%s
" is not an absolute path.',
+ $config;
+ defined do $config and last;
+ $@ and fatal '500 Internal Error',
+ 'Error loading configuration file "%s
": %s', + $config, $@; + fatal '500 Internal Error', + 'Cannot read configuration file "
%s
": %s',
+ $config, $! || 'unknown error';
}
-undef %input;
-$query = $ENV{QUERY_STRING};
+# 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));
+ }
+}
-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{$_}++;
- }
- }
+$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;
+ }
}
-# 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}));
+undef %input;
-# Prevent cross-site scripting
-foreach (@unsafevars) {
- # Colons are needed in diffs between tags.
- if (defined($input{$_}) && $input{$_} =~ /[^\w\-.:]/) {
- fatal("500 Internal Error",
- 'Malformed query (%s=%s)',
- $_, $input{$_});
- }
+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);
-if (defined($input{"content-type"})) {
- fatal("500 Internal Error", "Unsupported content-type")
- if ($input{"content-type"} !~ /^[-0-9A-Za-z]+\/[-0-9A-Za-z]+$/);
+# --- 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! See @CVSrepositories
in ' .
+ 'the configuration file (%s
).',
+ $config);
+}
+undef $rootfound;
-$DEFAULTVALUE{'cvsroot'} = $cvstreedefault;
+$DEFAULTVALUE{cvsroot} = $CVSrepositories[0];
-foreach (keys %DEFAULTVALUE) {
+while (my ($key, $defval) = each %DEFAULTVALUE) {
- # replace not given parameters with the default parameters
- if (!defined($input{$_}) || $input{$_} eq "") {
+ # 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
- # variable in these forms (copt) which indicates that we just set
- # parameters with a checkbox
- if (!defined($input{"copt"})) {
+ # 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' isn't defined --> empty input is not the result
- # of empty input checkbox --> set default
- $input{$_} = $DEFAULTVALUE{$_}
- if (defined($DEFAULTVALUE{$_}));
- } else {
+ # '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');
- # '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"));
- }
- }
+ } 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{$_})));
+ }
}
# 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;
-}
-
-$defaultDiffType = $input{'f'};
-
-$logsort = $input{'logsort'};
-
{
- my @tmp = @CVSrepositories;
- my @pair;
-
- while (@pair = splice(@tmp, 0, 2)) {
- my ($key, $val) = @pair;
- my ($descr, $cvsroot) = @$val;
-
- next if !-d $cvsroot;
-
- $CVSROOTdescr{$key} = $descr;
- $CVSROOT{$key} = $cvsroot;
- push @CVSROOT, $key;
- }
+ 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;
+ }
}
-## Default CVS-Tree
-if (!defined($CVSROOT{$cvstreedefault})) {
- fatal("500 Internal Error",
- '$cvstreedefault
points to a repository (%s) not defined in %%CVSROOT
(edit your configuration file %s)',
- $cvstreedefault, $config);
-}
+$defaultDiffType = $input{f};
+$logsort = $input{logsort};
+
# 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 = $CVSrepositories[0];
}
$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) {
- do "$config_cvstree" or
- fatal("500 Internal Error",
- 'Error in loading configuration file: %sThe 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 %s forbidden.', - $where); -} +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)$/); + my ($basedir) = ($module =~ m,([^/]+)$,); - my $tmpexportdir = "$tmpdir/.cvsweb.$$." . int(time); + if ($basedir eq '' || $module eq '') { + fatal('500 Internal Error', + 'You cannot download the top level directory.'); + } - mkdir($tmpexportdir, 0700) - or fatal("500 Internal Error", - 'Unable to make temporary directory: %s', - $!); + unless ($ext eq '.tar.gz' || $ext eq '.tgz') { + fatal('404 Not Found', '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 ($tag eq 'MAIN') { - $tag = 'HEAD'; - } + 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 (system $CMD{cvs}, @cvs_options, '-Qd', $cvsroot, 'export', '-r', - $tag, '-d', "$tmpexportdir/$basedir", $module) - { - @fatal = ("500 Internal Error", - 'cvs co failure: %s: %s', - $!, $module); - } else { - $| = 1; # Essential to get the buffering right. + } else { - if ($ext eq '.tar.gz') { - print "Content-Type: application/x-gzip\r\n\r\n"; + $| = 1; # Essential to get the buffering right. + local (*TAR_OUT); - system - "$CMD{tar} @tar_options -cf - -C $tmpexportdir $basedir | $CMD{gzip} @gzip_options -c" - and @fatal = - ("500 Internal Error", - 'tar zc failure: %s: %s', - $!, $basedir); - } elsif ($ext eq '.zip' && $CMD{zip}) { - print "Content-Type: application/zip\r\n\r\n"; + my (@cmd, $ctype); + my @tar = ($CMD{tar}, @tar_options, '-cf', '-', $basedir); + my @gzip = ($CMD{gzip}, @gzip_options, '-c'); + push(@cmd, \@tar, '|', \@gzip); + $ctype = 'application/x-gzip'; + push(@cmd, '>pipe', \*TAR_OUT); - system - "cd $tmpexportdir && $CMD{zip} @zip_options -r - $basedir" - and @fatal = - ("500 Internal Error", - 'zip failure: %s: %s', - $!, $basedir); - } else { - @fatal = - ("500 Internal Error", - 'unsupported file type'); - } - } + my ($h, $err) = startproc(@cmd); + if ($h) { + print "Content-Type: $ctype\r\n\r\n"; + local $/ = undef; + print
%s', + $? >> 8 || -1, $err); + } + } - system $CMD{rm}, '-rf', $tmpexportdir if -d $tmpexportdir; + # Clean up. + chdir(".."); + rmtree($tmpexportdir); - &fatal(@fatal) if @fatal; + &fatal(@fatal) if @fatal; - exit; + 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 = 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); - if ($use_descriptions && open(DESC, "<$cvsroot/CVSROOT/descriptions")) - { - while (
%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 \n";
+ while (
';
+ }
+ 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 '/') { + chooseCVSRoot(); + } else { + print 'Current directory: ', clickablePath($where, 0), ''; + print "
\n"; + print "Current tag: ", htmlquote($input{only_with_tag}), "
\n" + if $input{only_with_tag}; + } - } + print "