##
sub readableTime($$)
{
my ($secs, $long) = @_;
# This function works correctly for time >= 2 seconds.
return 'very little time' if ($secs < 2);
my %desc = (
1 => 'second',
60 => 'minute',
3600 => 'hour',
86400 => 'day',
604800 => 'week',
2628000 => 'month',
31536000 => 'year'
);
my @breaks = sort { $a <=> $b } keys %desc;
my $i = 0;
while ($i <= $#breaks && $secs >= 2 * $breaks[$i]) {
$i++;
}
$i--;
my $break = $breaks[$i];
my $retval = plural_write(int($secs / $break), $desc{$break});
if ($long == 1 && $i > 0) {
my $rest = $secs % $break;
$i--;
$break = $breaks[$i];
my $resttime = plural_write(int($rest / $break), $desc{$break});
if ($resttime) {
$retval .= ", $resttime";
}
}
return $retval;
}
#
# Returns a htmlified path where each directory is a link for faster
# navigation. $clickLast controls whether the basename
# (last directory/file) is a link as well. The passed in $pathname should
# *not* be URI escaped.
#
sub clickablePath($$)
{
my ($pathname, $clickLast) = @_;
my $root = '[' . htmlquote($CVSROOTdescr{$cvstree} || $cvstree) . ']';
# This should never happen (see chooseCVSRoot()), but let's be sure...
return $root if ($pathname eq '/');
my $retval =
' ' . &link($root, sprintf('%s/%s#dirlist', $scriptname, $query));
my $wherepath = '';
my ($lastslash) = $pathname =~ m|/$|;
foreach (split(m|/|, $pathname)) {
$retval .= ' / ';
$wherepath .= "/$_";
my $last = "$wherepath/" eq "/$pathname" || $wherepath eq "/$pathname";
if ($clickLast || !$last) {
$retval .= &link(htmlquote($_),
join ('',
$scriptname, uri_escape_path($wherepath),
(!$last || $lastslash ? '/' : ''), $query,
(!$last || $lastslash ? "#dirlist" : "")));
} else { # do not make a link to the current dir
$retval .= htmlquote($_);
}
}
return $retval;
}
sub chooseCVSRoot()
{
print "
EOF
}
sub chooseMirror()
{
# This code comes from the original BSD-cvsweb
# and may not be useful for your site; If you don't
# set %MIRRORS this won't show up, anyway.
scalar(%MIRRORS) or return;
# Should perhaps exclude the current site somehow...
print "\n\nThis CVSweb is mirrored in\n";
my @tmp = map(&link(htmlquote($_), $MIRRORS{$_}), sort keys %MIRRORS);
my $tmp = pop (@tmp);
if (scalar(@tmp)) {
print join (', ', @tmp), ' and ';
}
print "$tmp.\n
\n";
}
sub fileSortCmp()
{
(my $af = $a) =~ s/,v$//;
(my $bf = $b) =~ s/,v$//;
my ($rev1, $date1, $log1, $author1, $filename1) = @{$fileinfo{$af}}
if (defined($fileinfo{$af}));
my ($rev2, $date2, $log2, $author2, $filename2) = @{$fileinfo{$bf}}
if (defined($fileinfo{$bf}));
my $comp = 0;
if (defined($filename1) && defined($filename2) &&
$af eq $filename1 && $bf eq $filename2)
{
# Two files
$comp = -revcmp($rev1, $rev2) if ($byrev && $rev1 && $rev2);
$comp = ($date2 <=> $date1) if ($bydate && $date1 && $date2);
if ($input{ignorecase}) {
$comp = (uc($log1) cmp uc($log2)) if ($bylog && $log1 && $log2);
$comp = (uc($author1) cmp uc($author2)) if ($byauthor &&
$author1 && $author2);
} else {
$comp = ($log1 cmp $log2) if ($bylog && $log1 && $log2);
$comp = ($author1 cmp $author2) if ($byauthor &&
$author1 && $author2);
}
}
if ($comp == 0) {
# Directories first, then files under version control,
# then other, "rogue" files.
# Sort by filename if no other criteria available.
my $ad = (
(-d "$fullname/$a")
? 'D'
: (defined($fileinfo{$af}) ? 'F' : 'R')
);
my $bd = (
(-d "$fullname/$b")
? 'D'
: (defined($fileinfo{$bf}) ? 'F' : 'R')
);
(my $c = $a) =~ s|.*/||;
(my $d = $b) =~ s|.*/||;
my ($l, $r) = ("$ad$c", "$bd$d");
$comp = $input{ignorecase} ? (uc($l) cmp uc($r)) : ($l cmp $r);
# Parent dir is always first, then Attic.
if ($comp != 0) {
if ($l eq 'D..') {
$comp = -1;
} elsif ($r eq 'D..') {
$comp = 1;
} elsif ($l eq 'DAttic') {
$comp = -1;
} elsif ($r eq 'DAttic') {
$comp = 1;
}
}
}
return $comp;
}
#
# Returns a URL to download the selected revision.
# Expects the passed in URL to be URI escaped, relative, and without a query
# string.
#
sub download_url($$;$)
{
my ($url, $revision, $mimetype) = @_;
my @dots = $revision =~ /\./g;
$revision =~ s/\b0\.(?=\d+$)// if (scalar(@dots) & 1);
if (!defined($mimetype) || $mimetype !~ CVSWEBMARKUP) {
my $path = $where;
$path =~ s|[^/]+$||;
$url = "$scriptname/$CheckoutMagic/$path$url";
}
$url .= '?rev=' . uri_escape($revision);
$url .= ';content-type=' . uri_escape($mimetype) if $mimetype;
return $url;
}
#
# Returns a link to download the selected revision.
# Expects the passed in URL to be URI escaped, relative,
# and without a query string.
#
sub download_link($$$;$)
{
my ($url, $revision, $textlink, $mimetype) = @_;
return sprintf('%s',
download_url($url, $revision, $mimetype) . $barequery,
htmlquote($textlink));
}
#
# Returns a URL to display the selected revision.
# Expects the passed in URL to be URI escaped, and without a query string.
#
sub display_url($$;$)
{
my ($url, $revision, $mimetype) = @_;
$url .= '?rev=' . uri_escape($revision);
$url .= ';content-type=' . uri_escape($mimetype) if $mimetype;
return $url;
}
#
# Returns a link to display the selected revision.
# Expects the passed in URL to be URI escaped, and without a query string.
#
sub display_link($$;$$)
{
my ($url, $revision, $textlink, $mtype) = @_;
$textlink = $revision unless defined($textlink);
return sprintf('%s',
display_url($url, $revision, $mtype) . $barequery,
htmlquote($textlink));
}
#
# Expects the passed in URL to be URI escaped, and without a query string.
# The passed in link text should be already HTML escaped as appropriate.
#
sub graph_link($;$)
{
my ($url, $text) = @_;
$text ||= $graphicon;
return sprintf('%s', $url, $barequery, $text);
}
#
# Returns a link to CVSHistory for the given directory and filename.
#
sub history_link($$;$)
{
my ($dir, $file, $text) = @_;
$dir ||= '';
$file ||= '';
$text ||= 'History';
return &link($text,
sprintf('%s?cvsroot=%s;dsearch=%s;fsearch=%s;limit=1',
$cvshistory_url, uri_escape($input{cvsroot} || ''),
uri_escape($dir), uri_escape($file)));
}
# Returns a Query string with the
# specified parameter toggled
sub toggleQuery($;$)
{
my ($toggle, $value) = @_;
my %vars = %input;
if (defined($value)) {
$vars{$toggle} = $value;
} else {
$vars{$toggle} = $vars{$toggle} ? 0 : 1;
}
# Build a new query of non-default paramenters
my $newquery = "";
foreach my $var (@stickyvars) {
my ($value) = defined($vars{$var}) ? $vars{$var} : "";
my ($default) = defined($DEFAULTVALUE{$var}) ? $DEFAULTVALUE{$var} : "";
if ($value ne $default) {
$newquery .= ';' if ($newquery ne "");
$newquery .= uri_escape($var) . '=' . uri_escape($value);
}
}
if ($newquery) {
return '?' . $newquery;
}
return "";
}
sub htmlquote($)
{
local ($_) = @_;
# Special Characters; RFC 1866
s/&/&/g;
s/\"/"/g;
s//>/g;
return $_;
}
sub htmlunquote($)
{
local ($_) = @_;
# Special Characters; RFC 1866
s/"/\"/g;
s/<//g;
s/&/&/g;
return $_;
}
sub uri_escape_path($)
{
return join('/', map(uri_escape($_), split(m|/+|, shift, -1)));
}
sub http_header(;$$)
{
my ($content_type, $moddate) = @_;
$content_type ||= 'text/html';
$content_type .= "; charset=$charset"
if ($charset && $content_type =~ m,^text/,);
# Note that in the following, we explicitly join() and concatenate the
# headers instead of printing them as an array. This is because some
# systems, eg. early versions of mod_perl 2 don't quite get it if the
# last \r\n\r\n isn't included in the last "payload" header print().
my @headers = ();
# TODO: ctime(3) from scalar gmtime() isn't HTTP compliant, see HTTP::Date.
push(@headers, 'Last-Modified: ' . scalar gmtime($moddate) . ' GMT')
if $moddate;
push(@headers, 'Content-Type: ' . $content_type);
if ($allow_compress && $maycompress) {
if (HAS_ZLIB
|| (defined($CMD{gzip}) && open(GZIP, "| $CMD{gzip} -1 -c")))
{
push(@headers, 'Content-Encoding: x-gzip');
push(@headers, 'Vary: Accept-Encoding'); # RFC 2616, 14.44
print join("\r\n", @headers) . "\r\n\r\n";
$| = 1;
$| = 0; # Flush header output.
tie(*GZIP, __PACKAGE__, \*STDOUT) if HAS_ZLIB;
select(GZIP);
$gzip_open = 1;
} else {
print join("\r\n", @headers) . "\r\n\r\n";
printf
'Unable to find gzip binary in the $command_path (%s) to compress output
',
htmlquote(join(':', @command_path));
}
} else {
print join("\r\n", @headers) . "\r\n\r\n";
}
}
sub html_header($;$)
{
my ($title, $moddate) = @_;
$title = htmlquote($title);
my $l = $logo || '';
my $css = $CSS || '';
http_header('text/html', $moddate);
print <
$title
$HTML_META$css
$l $title
EOH
}
sub html_footer()
{
print "
\n$address\n" if $address;
print "\n\n";
}
sub link_tags($)
{
my ($tags) = @_;
(my $filename = $where) =~ s|^.*/||;
my $fileurl = './' . uri_escape($filename);
my $ret = "";
foreach my $sym (split(", ", $tags)) {
$ret .= ",\n" if ($ret ne "");
$ret .= &link(htmlquote($sym),
$fileurl . toggleQuery('only_with_tag', $sym));
}
return $ret;
}
#
# See if a file/dir is listed in the config file's @ForbiddenFiles list.
# Takes a full file system path or one relative to $cvsroot, and strips the
# trailing ",v" if present, then compares. Returns 1 if forbidden, else 0.
#
sub forbidden($)
{
(my $path = canonpath(shift)) =~ s/,v$//;
$path =~ s|^$cvsroot/+||;
for my $forbidden_re (@ForbiddenFiles) {
return 1 if ($path =~ $forbidden_re);
}
return 0;
}
#
# Starts a process using IPC::Run. All arguments are passed to
# IPC::Run::start() as-is. Returns an array ($harness, $error) where
# $harness is from IPC::Run if start() succeeds, undef otherwise. In case
# of an error, $error contains the error message.
#
sub startproc(@)
{
my $h = my $err = undef;
eval {
local $SIG{__DIE__};
$h = IPC::Run::start(@_) or die("return code: $?");
};
if ($@) {
$h->finish() if $h;
$h = undef;
$err = "'@{$_[0]}' failed: $@";
}
return ($h, $err);
}
#
# Runs a process using IPC::Run. All arguments are passed to
# IPC::Run::run() as-is. Returns an array ($exitcode, $errormsg).
#
sub runproc(@)
{
eval {
local $SIG{__DIE__};
IPC::Run::run(@_);
};
my $exitcode = $? >> 8;
my $errormsg = undef;
if ($@) {
$exitcode ||= -1;
$errormsg = "'@{$_[0]}' failed: $@";
}
return ($exitcode, $errormsg);
}
#
# Check out a file to a temporary file.
#
sub checkout_to_temp($$$)
{
my ($cvsroot, $cvsname, $rev) = @_;
# Pipe given cvs file into a temporary place.
my ($temp_fh, $temp_fn) = tempfile('.cvsweb.XXXXXXXX', DIR => tmpdir());
my @cmd = ($CMD{cvs}, @cvs_options, '-Qd', $cvsroot,
'co', '-p', "-r$rev", $cvsname);
local (*DIFF_OUT);
my ($h, $err) = startproc(\@cmd, \"", '>pipe', \*DIFF_OUT);
if ($h) {
local $/ = undef;
print $temp_fh ;
$h->finish();
close($temp_fh);
} else {
close($temp_fh);
unlink($temp_fn);
fatal('500 Internal Error',
'Checkout failure (exit status %s), output: %s
',
$? >> 8 || -1, $err);
}
return $temp_fn;
}
#
# Close the GZIP handle, and remove the tie.
#
sub gzipclose
{
if ($gzip_open) {
select(STDOUT);
close(GZIP);
untie *GZIP;
$gzip_open = 0;
}
}
# implement a gzipped file handle via the Compress:Zlib compression
# library.
sub MAGIC1() { 0x1f }
sub MAGIC2() { 0x8b }
sub OSCODE() { 3 }
sub TIEHANDLE
{
my ($class, $out) = @_;
my ($d) = Compress::Zlib::deflateInit(
-Level => Compress::Zlib::Z_BEST_COMPRESSION(),
-WindowBits => -Compress::Zlib::MAX_WBITS()
)
or return undef;
my ($o) = { handle => $out,
dh => $d,
crc => 0,
len => 0,
};
my ($header) = pack("c10",
MAGIC1, MAGIC2, Compress::Zlib::Z_DEFLATED(),
0, 0, 0, 0, 0, 0, OSCODE);
print {$o->{handle}} $header;
return bless($o, $class);
}
sub PRINT
{
my ($o) = shift;
my ($buf) = join (defined($,) ? $, : "", @_);
my ($len) = length($buf);
my ($compressed, $status) = $o->{dh}->deflate($buf);
print {$o->{handle}} $compressed if defined($compressed);
$o->{crc} = Compress::Zlib::crc32($buf, $o->{crc});
$o->{len} += $len;
return $len;
}
sub PRINTF
{
my ($o) = shift;
my ($fmt) = shift;
my ($buf) = sprintf($fmt, @_);
my ($len) = length($buf);
my ($compressed, $status) = $o->{dh}->deflate($buf);
print {$o->{handle}} $compressed if defined($compressed);
$o->{crc} = Compress::Zlib::crc32($buf, $o->{crc});
$o->{len} += $len;
return $len;
}
sub WRITE
{
my ($o, $buf, $len, $off) = @_;
my ($compressed, $status) = $o->{dh}->deflate(substr($buf, 0, $len));
print {$o->{handle}} $compressed if defined($compressed);
$o->{crc} = Compress::Zlib::crc32(substr($buf, 0, $len), $o->{crc});
$o->{len} += $len;
return $len;
}
sub CLOSE
{
my ($o) = @_;
return if !defined($o->{dh});
my ($buf) = $o->{dh}->flush();
$buf .= pack("V V", $o->{crc}, $o->{len});
print {$o->{handle}} $buf;
undef $o->{dh};
}
sub DESTROY
{
my ($o) = @_;
CLOSE($o);
}
# Local variables:
# indent-tabs-mode: nil
# cperl-indent-level: 2
# End:
cvsweb-3.0.6/samples/ 0000755 0000000 0000000 00000000000 07741340327 013162 5 ustar root root cvsweb-3.0.6/samples/cvsweb-httpd.conf 0000644 0000000 0000000 00000001445 07741340327 016447 0 ustar root root # -*- apache -*-
# $FreeBSD: projects/cvsweb/samples/cvsweb-httpd.conf,v 1.1 2003/10/05 21:03:20 scop Exp $
#
# Sample configuration file snippet for running FreeBSD-CVSweb
# with Apache. Include this in your httpd.conf and modify the
# paths according to your setup.
# Note: this affects all mod_perl scripts in the server, not just cvsweb.cgi.
# mod_perl >= 1.99:
PerlSwitches -T
# See also $charset in cvsweb.conf.
#AddDefaultCharset UTF-8
# mod_perl >= 1.99:
SetHandler perl-script
PerlResponseHandler ModPerl::Registry
PerlOptions +ParseHeaders
Options ExecCGI
#mod_perl < 1.99:
# TODO