From 47d54316fb86c855f7871f0191dd5a2c9fed5589 Mon Sep 17 00:00:00 2001 From: "Simon L. B. Nielsen" Date: Sat, 17 Mar 2007 22:28:31 +0000 Subject: [PATCH] Merge CVSweb 3.0.6 into HEAD. This was basically done as a manual merge the relevant parts onto CVSweb 3.0.6 stock files, so it is not entirely impossible that some local changes were lost, though I don't think/hope so. The use of cgi-style.pl was merged by danger@. He also, together with Dan Langille, got CVSweb 3 tested against FreshPorts prior to commit, so this update should not blow up FreshPorts. Thanks to both for the help. Note that this now means that the FreeBSD CGI scripts more or less require perl 5.8 (or at least something newer than 5.0), to run without local modifications - but people really shouldn't be running perl 5.0 these days anyway... (no comments on the fact that www.FreeBSD.org did this until ~2 hours ago... ). --- en/cgi/cvsweb.cgi | 6948 ++++++++++++++++++++---------------- en/cgi/cvsweb.conf | 771 ++-- en/cgi/cvsweb.conf-freebsd | 4 +- en/cgi/cvsweb.conf-netbsd | 4 +- en/cgi/cvsweb.conf-openbsd | 4 +- 5 files changed, 4309 insertions(+), 3422 deletions(-) diff --git a/en/cgi/cvsweb.cgi b/en/cgi/cvsweb.cgi index 8459e85637..466400138f 100755 --- a/en/cgi/cvsweb.cgi +++ b/en/cgi/cvsweb.cgi @@ -1,4 +1,4 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl -T # # cvsweb - a CGI interface to CVS trees. # @@ -21,7 +21,7 @@ # (c) 1998-1999 Henner Zeller # (c) 1999 Henrik Nordstrom # (c) 2000-2002 Akinori MUSHA -# (c) 2002 Ville Skyttä +# (c) 2002-2005 Ville Skyttä # All rights reserved. # # Redistribution and use in source and binary forms, with or without @@ -45,60 +45,120 @@ # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF # SUCH DAMAGE. # -# $Id: cvsweb.cgi,v 1.90 2007-03-17 20:53:48 simon Exp $ +# $FreeBSD: www/en/cgi/cvsweb.cgi,v 1.1.1.37 2007/03/17 21:52:33 simon Exp $ +# $Id: cvsweb.cgi,v 1.91 2007-03-17 22:28:31 simon Exp $ # $Idaemons: /home/cvs/cvsweb/cvsweb.cgi,v 1.84 2001/10/07 20:50:10 knu Exp $ -# $FreeBSD: www/en/cgi/cvsweb.cgi,v 1.89 2005/10/28 14:55:57 fenner 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 @unsafevars - %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 $output_filter $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 - $allow_log_extra $allow_dir_extra $allow_source_extra - $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 - @annotate_options $LOG_FILESEPARATOR $LOG_REVSEPARATOR - $tmpdir $HTML_DOCTYPE $HTML_META + $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 %funcline_regexp + $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::Basename qw(dirname); +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.0.6'; + + $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~'; + + $cgi_style::hsty_base = 'http://www.FreeBSD.org'; + $_ = q$FreeBSD: www/en/cgi/cvsweb.cgi,v 1.89 2005/10/28 14:55:57 fenner Exp $; + @_ = split; + $cgi_style::hsty_date = "@_[3,4]"; + + # warningproof + 0 if $cgi_style::hsty_base ne $cgi_style::hsty_date; + + package cgi_style; + require "./cgi-style.pl"; + package main; +} + +# ----------------------------------------------------------------------------- + sub printDiffSelect($); -sub printDiffLinks($$); +sub printDiffSelectStickyVars(); +sub getDiffLinks($$$); sub printLogSortSelect($); sub findLastModifiedSubdirs(@); sub htmlify_sub(&$); @@ -107,25 +167,30 @@ sub spacedHtmlText($;$); sub link($$); sub revcmp($$); sub fatal($$@); -sub redirect($); +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($$); @@ -134,167 +199,139 @@ 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($$$); + +# 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)}); + +my ($mydir) = (dirname($0) =~ /(.*)/); # untaint ##### Start of Configuration Area ######## -delete $ENV{PATH}; - -$cvsweb_revision = '2.0.6'; - -use File::Basename (); - -($mydir) = (File::Basename::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; - } +for (catfile($mydir, 'cvsweb.conf'), '/usr/local/etc/cvsweb/cvsweb.conf') { + if (-r $_) { + $config = $_; + last; + } } -# == Configuration defaults == -# Defaults for configuration variables that shouldn't need -# to be configured.. -$allow_version_select = 1; -$allow_log_extra = 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 = $HTML_DOCTYPE = $HTML_META = undef; -$tmpdir = defined($ENV{TMPDIR}) ? $ENV{TMPDIR} : "/var/tmp"; +undef $mydir; -$LOG_FILESEPARATOR = q/^={77}$/; -$LOG_REVSEPARATOR = q/^-{28}$/; +######## Configuration parameters ######### + +@CVSrepositories = @CVSROOT = %CVSROOT = %MIRRORS = %DEFAULTVALUE = %ICONS = + %MTYPES = %tags = %alltags = %fileinfo = %DIFF_COMMANDS = (); + +$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; + +$allow_version_select = $allow_mailtos = $allow_log_extra = 1; @DIFFTYPES = qw(h H u c s); @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, + }, + { + 'descr' => 'side by side', + # width=168 should be enough to support 80 character line lengths + 'opts' => ['--side-by-side', '--width=168'], + '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', }, ); -$cgi_style::hsty_base = 'http://www.FreeBSD.org'; -$_ = q$FreeBSD: www/en/cgi/cvsweb.cgi,v 1.89 2005/10/28 14:55:57 fenner Exp $; -@_ = split; -$cgi_style::hsty_date = "@_[3,4]"; +##### End of configuration parameters ##### -# warningproof -0 if $cgi_style::hsty_base ne $cgi_style::hsty_date; +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}); +} -package cgi_style; -require "$main::mydir/cgi-style.pl"; -package main; +$scriptname = '' unless defined($scriptname); -$HTML_DOCTYPE = - ''; - -$HTML_META = < - - - -EOM - -##### End of configuration variables ##### - -use Time::Local (); -use IPC::Open2 qw(open2); - -# 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|^/*|/|; +$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`); @@ -313,803 +350,943 @@ $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); -@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); +# +# Load configuration. +# if (-f $config) { - do "$config" or fatal("500 Internal Error", - 'Error in loading configuration file: %s

%s
', - $config, $@); + 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); + +# --- 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; + $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; + +# +# 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); } -# 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})); +$DEFAULTVALUE{cvsroot} = $cvstreedefault; -# 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{$_}); - } -} +while (my ($key, $defval) = each %DEFAULTVALUE) { -if (defined($input{"content-type"})) { - fatal("500 Internal Error", "Unsupported content-type") - if ($input{"content-type"} !~ /^[-0-9A-Za-z]+\/[-0-9A-Za-z]+$/); -} + # Replace not given parameters with defaults. + next unless (defined($defval) && $defval =~ /\S/ && !defined($input{$key})); -$DEFAULTVALUE{'cvsroot'} = $cvstreedefault; + # 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}) { -foreach (keys %DEFAULTVALUE) { + # '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'); - # replace not given parameters with the default parameters - if (!defined($input{$_}) || $input{$_} eq "") { + } else { - # 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"})) { - - # 'copt' isn't defined --> empty input is not the result - # of empty input checkbox --> set default - $input{$_} = $DEFAULTVALUE{$_} - if (defined($DEFAULTVALUE{$_})); - } else { - - # '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")); - } - } + # '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 sc)); + @DIFFTYPES{qw(uc cc sc)} = ( + { + 'descr' => 'unified, colored', + 'opts' => ['-u'], + 'colored' => 0, + }, + { + 'descr' => 'context, colored', + 'opts' => ['-c'], + 'colored' => 0, + }, + { + 'descr' => 'side by side, colored', + # width=168 should be enough to support 80 character line lengths + 'opts' => ['--side-by-side', '--width=168'], + '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; -} - -$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 = $cvstreedefault; } $cvsroot = $CVSROOT{$cvstree}; # create icons out of description foreach my $k (keys %ICONS) { - no strict 'refs'; - my ($itxt, $ipath, $iwidth, $iheight) = @{$ICONS{$k}}; - if ($ipath) { - ${"${k}icon"} = - sprintf( - '%s', - hrefquote($ipath), htmlquote($itxt), $iwidth, $iheight) - } else { - ${"${k}icon"} = $itxt; - } + my ($itxt, $ipath, $iwidth, $iheight) = @{$ICONS{$k}}; + no strict 'refs'; + if ($ipath) { + ${"${k}icon"} = + sprintf('%s', + 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, $@); + 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 %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|\.zip)$/); + 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', - $!); + 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 ($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); + 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 - "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 ; + $h->finish(); + } else { + @fatal = ('500 Internal Error', + '%s failure (exit status %s), output:
%s
', + $istar ? 'Tar' : 'Zip', $? >> 8 || -1, $err); + } + } - system $CMD{rm}, '-rf', $tmpexportdir if -d $tmpexportdir; + # Clean up. + 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 () { - chomp; - my ($dir, $description) = /(\S+)\s+(.*)/; - $descriptions{$dir} = $description; - } - close(DESC); - } + 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) { - print "\n"; - $infocols++; - printf "\n +EOF + printf('\n"; + 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 '\n"; - $infocols++; - printf '\n"; + $infocols++; + printf('', ($bydate ? ' class="sorted"' : '')); - 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 "\n"; - if ($show_author) { - $infocols++; - printf '\n"; - } - $infocols++; - printf '\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) { - printf '\n"; - $infocols++; - } - print "\n"; - } else { - print "\n"; - } - my $dirrow = 0; + if ($bylog) { + print 'Last log entry'; + } else { + print &link('Last log entry', + sprintf('./%s#dirlist', toggleQuery('sortby', 'log'))); + } + print "\n"; + } elsif ($use_descriptions) { + print "\n"; + $infocols++; + } + print "\n"; - my $i; - lookingforattic: - for ($i = 0 ; $i <= $#dir ; $i++) { - if ($dir[$i] eq "Attic") { - last lookingforattic; - } - } + my $dirrow = 0; - if (!$input{'hideattic'} && ($i <= $#dir) - && opendir($dh, $fullname . "/Attic")) - { - splice(@dir, $i, 1, grep((s|^|Attic/|, !m|/\.|), readdir($dh))); - closedir($dh); - } + my $i; + lookingforattic: + for ($i = 0; $i <= $#dir; $i++) { + if ($dir[$i] eq "Attic") { + last lookingforattic; + } + } - my $hideAtticToggleLink = - $input{'hideattic'} ? '' : - &link('[Hide]', sprintf('./%s#dirlist', &toggleQuery("hideattic"))); + if (!$input{hideattic} + && ($i <= $#dir) + && opendir($dh, $fullname . '/Attic')) + { + splice(@dir, $i, 1, grep((s|^|Attic/|, !m|/\.|), readdir($dh))); + closedir($dh); + } - # Sort without the Attic/ pathname. - # place directories first + my $hideAtticToggleLink = + $input{hideattic} + ? '' + : &link('[hide]', sprintf('./%s#dirlist', &toggleQuery('hideattic'))); - my $attic; - my $url; - my $fileurl; - my $filesexists; - my $filesfound; + # Sort without the Attic/ pathname. + # place directories first - foreach my $file (sort { &fileSortCmp } @dir) { + my $filesexists; + my $filesfound; - next if ($file eq '.'); + foreach my $file (sort { &fileSortCmp } @dir) { - # ignore CVS lock and stale NFS files - next if ($file =~ /^#cvs\.|^,|^\.nfs/); + next if ($file eq curdir()); - # Check whether to show the CVSROOT path - next if ($input{'hidecvsroot'} && $file 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 ($file && &forbidden_module($file)); + # 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/$file")); + # Is it a directory? + my $isdir = -d catdir($fullname, $file); - if ($file =~ s|^Attic/||) { - $attic = " (in the Attic) " . $hideAtticToggleLink; - } else { - $attic = ""; - } + # Ignore non-readable files and directories? + next if ($input{hidenonreadable} && (! -r _ || ($isdir && ! -x _))); - if ($file eq '..' || -d "$fullname/$file") { - next if ($file eq '..' && $where eq '/'); - my ($rev, $date, $log, $author, $filename) = - @{$fileinfo{$file}} - if (defined($fileinfo{$file})); - printf "\n\n\n\n\n\n\n\n\n\n\n\n\n\n"; - } else { - print "
\n"; - } - $dirrow++; - } elsif ($file =~ s/,v$//) { + print "\n\n"; + $dirrow++; - # Skip forbidden files now so we'll give no hint - # about their existence. This should probably have - # been done earlier, but it's straightforward here. - next if forbidden_file("$fullname/$file"); + } elsif ($file =~ s/,v$//) { - $fileurl = ($attic ? "Attic/" : "") . urlencode($file); - $url = './' . $fileurl . $query; - $filesexists++; - next if (!defined($fileinfo{$file})); - my ($rev, $date, $log, $author) = @{$fileinfo{$file}}; - $filesfound++; - printf "\n\n\n\n", ($dirrow % 2) ? 'even' : 'odd'; + printf '\n\n\n\n\n\n\n" if ($dirtable); - print(($dirtable) ? "" : "
"); - $dirrow++; - } - print "\n"; - } + if ($log) { + print htmlify(substr($log, 0, $shortLogLen), $allow_dir_extra); + print '...' if (length $log > 80); + } + print "\n"; + $dirrow++; + } + print "\n"; + } - print($dirtable ? "
", - $byfile ? $columnHeaderColorSorted : - $columnHeaderColorDefault; + printf(< +
', ($byfile ? ' class="sorted"' : '')); - if ($byfile) { - print 'File'; - } else { - print &link( - 'File', - sprintf( - './%s#dirlist', - &toggleQuery("sortby", "file") - ) - ); - } - print "', - $byrev ? $columnHeaderColorSorted : - $columnHeaderColorDefault; + # 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 "', - $bydate ? $columnHeaderColorSorted : - $columnHeaderColorDefault; + if ($byrev) { + print 'Rev.'; + } else { + print &link('Rev.', + sprintf('./%s#dirlist', toggleQuery('sortby', 'rev'))); + } + print "', - $byauthor ? $columnHeaderColorSorted : - $columnHeaderColorDefault; + if ($show_author) { + $infocols++; + printf('', ($byauthor ? ' class="sorted"' : '')); - if ($byauthor) { - print 'Author'; - } else { - print &link( - 'Author', - sprintf( - './%s#dirlist', - &toggleQuery( - "sortby", - "author" - ) - ) - ); - } - print "', - $bylog ? $columnHeaderColorSorted : - $columnHeaderColorDefault; + if ($byauthor) { + print 'Author'; + } else { + print + &link('Author', + sprintf('./%s#dirlist', toggleQuery('sortby', 'author'))); + } + print "', - $columnHeaderColorDefault; - print "Description
Description
", - $tabcolors[$dirrow % 2] if $dirtable; + my $attic = ''; + if ($file =~ s|^Attic/||) { + $attic = ' (in the Attic) ' . + $hideAtticToggleLink . ''; + } - if ($file eq '..') { - $url = "../$query"; - if ($nofilelinks) { - print $backicon; - } else { - print &link($backicon, $url); - } - print ' ', &link("Parent Directory", $url); - } else { - $url = './' . urlencode($file) . "/$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 "
", + ($dirrow % 2) ? 'even' : 'odd'; - if ($nofilelinks) { - print $diricon; - } else { - print &link($diricon, $url); - } - print ' ', &link("$file/", $url), $attic; + if ($file eq updir()) { + my $url = "../$query"; + print $nofilelinks ? $backicon : &link($backicon, $url); + print ' ', &link("Parent Directory", $url); - if ($file 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) { + print " "; + print readableTime(time() - $date, 0) if $date; + print "", htmlquote($author) + if $show_author; + print ""; + $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), $allow_dir_extra); - if (length $log > 80) { - print "..."; - } - print ""; - } - } else { - my ($dwhere) = - ($where ne "/" ? $where : "") . $file; + 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 " "; + $cols--; + } + } + } - if ($dirtable) { - print "
", - $tabcolors[$dirrow % 2] if $dirtable; - print ""; + 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 ($nofilelinks) { - print $fileicon; - } else { - print &link($fileicon, $url); - } - print ' ', &link(htmlquote($file), $url), $attic; - print " " if ($dirtable); - download_link($fileurl, $rev, $rev, - $defaultViewable ? "text/x-cvsweb-markup" : - undef); - print " " if ($dirtable); + printf "
', $allow_cvsgraph ? '' : ' colspan="2"'; - if ($date) { - print " ", readableTime(time() - $date, 0), - ""; - } - if ($show_author) { - print " " if ($dirtable); - print $author; - } - print " " if ($dirtable); + 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 "", display_link($fileurl, $rev); + print ""; + print readableTime(time() - $date, 0) if $date; + print "", htmlquote($author) if $show_author; + print ""; - if ($log) { - print " ", - &htmlify(substr($log, 0, $shortLogLen), $allow_dir_extra); - if (length $log > 80) { - print "..."; - } - print ""; - } - print "
\n" : "
\n"); + 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 ((my $num = scalar(@unreadable)) && ! $input{hidenonreadable}) { + printf(< + NOTE: The following %d unreadable files were ignored:
+ %s +

+EOF + } - if (scalar %tags || $input{only_with_tag} || $edit_option_form - || defined($input{"options"})) - { - 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 (scalar %tags || $input{only_with_tag}) { - print "
\n"; - foreach my $var (@stickyvars) { - print - "\n" - if (defined($input{$var}) - && (!defined($DEFAULTVALUE{$var}) - || $input{$var} ne $DEFAULTVALUE{$var}) - && $input{$var} ne "" && $var ne "only_with_tag"); - } - print "

\n"; - print "\n"; - print " \n"; - printf "\n", - htmlquote($where); - print "

\n"; - print "
\n"; - } + if (scalar %tags + || $input{only_with_tag} + || $edit_option_form + || defined($input{options})) + { + print "
\n"; + } - if ($allow_tar) { - my ($basefile) = ($where =~ m,(?:.*/)?([^/]+),); + if (scalar %tags || $input{only_with_tag}) { + print "
\n

\n"; + foreach my $var (@stickyvars) { + printf("\n", + htmlquote($input{$var})) + if (defined($input{$var}) + && (!defined($DEFAULTVALUE{$var}) + || $input{$var} ne $DEFAULTVALUE{$var}) + && $var ne 'only_with_tag'); + } + printf(< + + + +

+
+EOF + } - if (defined($basefile) && $basefile ne '') { - print "
\n", - "
Download this directory in "; + 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"; + } + } - # 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 "
\n"; - } - } + if ($edit_option_form || defined($input{options})) { - if ($edit_option_form || defined($input{"options"})) { - - my $formwhere = $scriptwhere; - $formwhere =~ s|Attic/?$|| if ($input{'hideattic'}); - - print "
\n"; - print "\n"; - if ($cvstree ne $cvstreedefault) { - print - "\n"; - } - print "
\n"; - print "\n\n"; - print "\n\n"; - print "\n\n"; - print "\n\n"; - print "\n\n"; - print "\n\n"; - print "\n\n\n
Preferences
"; - print "\n"; - printLogSortSelect(0); - print "
"; - printDiffSelect(0); - print ""; - print "
"; - print ""; - print "
\n
\n
\n"; - } - html_footer(); + print < +
+General options + +EOF + for my $v qw(hidecvsroot hidenonreadable) { + printf(qq{\n}, + $v, $input{$v} || 0); + } + if ($cvstree ne $cvstreedefault) { + print "\n"; + } + print < + + + + + +\n"; + print < + + + + +EOF + print ''; + print < + + + + + + +EOF + printLogSortSelect(0); + print < + + + + +EOF + print '\n"; + print < + + + + + + +EOF + printDiffSelect(0); + print < + + + + + +
+ +EOF + } + html_footer(); } ############################### @@ -1117,2583 +1294,3149 @@ if (-d $fullname) { ############################### elsif (-f $fullname . ',v') { - if (forbidden_file($fullname)) { - fatal('403 Forbidden', - 'Access forbidden. This file is mentioned in @ForbiddenFiles'); - return; - } + if (defined($input{rev}) || $doCheckout) { + &doCheckout($fullname, $input{rev}, $input{only_with_tag}); + gzipclose(); + exit; + } - if (defined($input{'rev'}) || $doCheckout) { - &doCheckout($fullname, $input{'rev'}); - gzipclose(); - exit; - } + if (defined($input{annotate}) && $allow_annotate) { + &doAnnotate($input{annotate}, $input{only_with_tag}); + gzipclose(); + exit; + } - if (defined($input{'annotate'}) && $allow_annotate) { - &doAnnotate($input{'annotate'}); - gzipclose(); - exit; - } + if (defined($input{r1}) && defined($input{r2})) { + &doDiff($fullname, $input{r1}, $input{tr1}, + $input{r2}, $input{tr2}, $input{f}); + gzipclose(); + exit; + } - if (defined($input{'r1'}) && defined($input{'r2'})) { - &doDiff( - $fullname, $input{'r1'}, - $input{'tr1'}, $input{'r2'}, - $input{'tr2'}, $input{'f'} - ); - gzipclose(); - exit; - } - print("going to dolog($fullname)\n") if ($verbose); - &doLog($fullname); + if ($allow_cvsgraph && $input{graph}) { + if ($input{makeimage}) { + doGraph(); + } else { + doGraphView(); + } + gzipclose(); + exit; + } - ############################## - # View Diff - ############################## -} elsif ($fullname =~ s/\.diff$// && -f $fullname . ",v" && $input{'r1'} - && $input{'r2'}) + &doLog($fullname); +} + +############################## +# View Diff +############################## +elsif ($fullname =~ s/\.diff$// + && -f $fullname . ',v' && $input{r1} && $input{r2}) { - # $where-diff-removal if 'cvs rdiff' is used - # .. but 'cvs rdiff'doesn't support some options - # rcsdiff does (-w and -p), so it is disabled - # $where =~ s/\.diff$//; + # $where-diff-removal if 'cvs rdiff' is used + # .. but 'cvs rdiff'doesn't support some options + # rcsdiff does (-w and -p), so it is disabled + # $where =~ s/\.diff$//; - # Allow diffs using the ".diff" extension - # so that browsers that default to the URL - # for a save filename don't save diff's as - # e.g. foo.c - &doDiff( - $fullname, $input{'r1'}, $input{'tr1'}, $input{'r2'}, - $input{'tr2'}, $input{'f'} - ); - gzipclose(); - exit; -} elsif (($newname = $fullname) =~ s|/([^/]+)$|/Attic/$1| && -f $newname . ",v") -{ + # Allow diffs using the ".diff" extension so that browsers that default + # to the filename in the URL when saving don't save diffs as eg. foo.c. + &doDiff($fullname, $input{r1}, $input{tr1}, + $input{r2}, $input{tr2}, $input{f}); + gzipclose(); + exit; - # The file has been removed and is in the Attic. - # Send a redirect pointing to the file in the Attic. - (my $newplace = $scriptwhere) =~ s|/([^/]+)$|/Attic/$1|; - if ($ENV{QUERY_STRING} ne "") { - redirect("${newplace}?$ENV{QUERY_STRING}"); - } else { - redirect($newplace); - } - exit; -} elsif (0 && (my @files = &safeglob($fullname . ",v"))) { - http_header("text/plain"); - print "You matched the following files:\n"; - print join ("\n", @files); +} - # Find the tags from each file - # Display a form offering diffs between said tags -} else { - my $fh = do { local (*FH); }; - my ($xtra, $module); +elsif (do { (my $tmp = $fullname) =~ s|/([^/]+)$|/Attic/$1|; -f "$tmp,v" }) { + # The file has been removed and is in the Attic. + # Send a redirect pointing to the file in the Attic. + (my $newplace = $scriptwhere) =~ s|/([^/]+)$|/Attic/$1|; + if ($ENV{QUERY_STRING} ne "") { + redirect("$newplace?$ENV{QUERY_STRING}"); + } else { + redirect($newplace); + } + exit; - # Assume it's a module name with a potential path following it. - $xtra = (($module = $where) =~ s|/.*||) ? $& : ''; +} - # Is there an indexed version of modules? - if (open($fh, "< $cvsroot/CVSROOT/modules")) { - while (<$fh>) { - if (/^(\S+)\s+(\S+)/o && $module eq $1 - && -d "$cvsroot/$2" && $module ne $2) - { - redirect("$scriptname/$2$xtra$query"); - } - } - } - fatal("404 Not Found", - '%s: no such file or directory', - $where); +elsif (0 && (my @files = &safeglob($fullname . ",v"))) { + http_header("text/plain"); + print "You matched the following files:\n"; + print join ("\n", @files); + + # TODO: + # Find the tags from each file + # Display a form offering diffs between said tags +} + +else { + # Assume it's a module name with a potential path following it. + my $module; + my $xtra = (($module = $where) =~ s|(/.*)||) ? $1 : ''; + + # Is there an indexed version of modules? + my $fh = do { local (*FH); }; + if (open($fh, catfile($cvsroot, 'CVSROOT', 'modules'))) { + while (<$fh>) { + if (/^(\S+)\s+(\S+)/o + && $module eq $1 + && $module ne $2 + && -d "$cvsroot/$2") + { + close($fh); + redirect("$scriptname/$2$xtra$query"); + } + } + close($fh); + } + fatal("404 Not Found", '%s: no such file or directory', $where); } gzipclose(); ## End MAIN -sub printDiffSelect($) { - my ($use_java_script) = @_; - my $f = $input{'f'}; - print '\n"; - print ""; + for my $difftype (@DIFFTYPES) { + printf("\n", + $difftype, $input{f} eq $difftype ? ' selected="selected"' : '', + "\u$DIFFTYPES{$difftype}{descr}"); + } + + print ""; } -sub printLogSortSelect($) { - my ($use_java_script) = @_; - print '"; +sub printDiffSelectStickyVars() +{ + while (my ($key, $val) = each %input) { + next if ($key eq 'f'); + next if (defined($DEFAULTVALUE{$key}) && $DEFAULTVALUE{$key} eq $val); + print "\n"; + } } -sub findLastModifiedSubdirs(@) { - my (@dirs) = @_; - my ($dirname, @files); - foreach $dirname (@dirs) { - next if ($dirname eq "."); - next if ($dirname eq ".."); - my ($dir) = "$fullname/$dirname"; - next if (!-d $dir); +sub printLogSortSelect($) +{ + my ($use_java_script) = @_; - my ($lastmod) = undef; - my ($lastmodtime) = undef; - my $dh = do { local (*DH); }; + print '"; } -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); - } +# +# 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) = @_; - $result; + 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; + } + } + push(@files, $lastmod) if (defined($lastmod)); + } + return @files; } -sub htmlify($;$) { - (local $_, my $extra) = @_; - $_ = htmlquote($_); +sub htmlify_sub(&$) +{ + (my $proc, local $_) = @_; + my @a = split(m|(]+>[^<]*)|i); + my $linked; + my $result = ''; - # get URL's as link - s{ - (http|ftp|https)://\S+ - }{ - &link($&, htmlunquote($&)) - }egx; + while (($_, $linked) = splice(@a, 0, 2)) { + &$proc(); + $result .= $_ if defined($_); + $result .= $linked if defined($linked); + } - # get e-mails as link - $_ = htmlify_sub { - s< - [\w+=\-.!]+@[\w\-]+(\.[\w\-]+)+ - >< - &link($&, "mailto:$&") - >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([a-zA-Z][\w.]+) - (?: - \( ([0-9n]) \)\B - | - \.([0-9n])\b - ) - ) - }{ - &link($1, sprintf($mancgi, defined($3) ? $3 : $4, $2)) - }egx; - } - $_; - } - } - - $_; + return $result; } -sub spacedHtmlText($;$) { - local $_ = $_[0]; - my $ts = $_[1] || $tabstop; - # Cut trailing spaces and tabs - s/[ \t]+$//; +sub htmlify($;$) +{ + (local $_, my $extra) = @_; - if (defined($ts)) { + $_ = htmlquote($_); - # Expand tabs - 1 while s/\t+/' ' x (length($&) * $ts - length($`) % $ts)/e - } + # get URL's as link + s{ + ((https?|ftp)://.+?)([\s\']|&(quot|[lg]t);) + }{ + &link($1, htmlunquote($1)) . $3 + }egx; - # replace and (\001 is to protect us from htmlify) - # gzip can make excellent use of this repeating pattern :-) - if ($hr_breakable) { + if ($allow_mailtos) { + # Make mailto: links from email addresses. + $_ = htmlify_sub { + s< + ([\w+=\-.!]+@[\w\-]+(?:\.[\w\-]+)+) + >< + &link($1, "mailto:$1") + >egix; + } $_; + } - # make every other space 'breakable' - s/ / \001nbsp;/g; # 2 * - # leave single space as it is - } else { - s/ /\001nbsp;/g; - } + if ($extra) { - $_ = htmlify($_, $allow_source_extra); + # get PR #'s as link: "PR#nnnn" "PR: nnnn, ..." "PR nnnn, ..." "bin/nnnn" + if (defined($prcgi) && defined($re_prkeyword)) { + my $prev; - # unescape - y/\001/&/; + do { + $prev = $_; - return $_; + $_ = 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, $section, uri_escape($name))) + : $text; + }egx; + } $_; + } + } + + return $_; } + +sub spacedHtmlText($;$) +{ + (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) = @_; - - $url =~ s/:/sprintf("%%%02x", ord($&))/eg - if $url =~ /^[^a-z]/; # relative - - sprintf '%s', hrefquote($url), $name; +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.]/; +sub revcmp($$) +{ + my ($rev1, $rev2) = @_; - my (@r1) = split (/\./, $rev1); - my (@r2) = split (/\./, $rev2); - my ($a, $b); + # make no comparison for a tag or a branch + return 0 if $rev1 =~ /[^\d.]/ || $rev2 =~ /[^\d.]/; - while (($a = shift (@r1)) && ($b = shift (@r2))) { - if ($a != $b) { - return $a <=> $b; - } - } - if (@r1) { return 1; } - if (@r2) { return -1; } - return 0; + 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; } -sub fatal($$@) { - my ($errcode, $format, @args) = @_; - if ($is_mod_perl) { - Apache->request->status((split (/ /, $errcode))[0]); - } else { - print "Status: $errcode\r\n"; - } - html_header("Error"); - print "

Error: ", - sprintf($format, map(htmlquote($_), @args)), - "

\n"; - html_footer(); - exit(1); + +# +# Signal a fatal error. +# +sub fatal($$@) +{ + my ($errcode, $format, @args) = @_; + print "Status: $errcode\r\n"; + html_header('Error'); + print '
Error: ', + sprintf($format, map(htmlquote($_), @args)), "
\n"; + html_footer(); + exit(1); } -sub redirect($) { - my ($url) = @_; - if ($is_mod_perl) { - Apache->request->status(301); - Apache->request->header_out(Location => $url); - } else { - print "Status: 301 Moved\r\n"; - print "Location: $url\r\n"; - } - html_header("Moved"); - print "

This document is located ", &link('here', $url), "

\n"; - html_footer(); - exit(1); + +# +# Signal a (fatal) configuration error. +# +sub config_error($$) +{ + fatal('500 Internal Error', + 'Error loading configuration file "%s":

' . + '%s
', @_); } -sub safeglob($) { - my ($filename) = @_; - my ($dirname); - my (@results); - my $dh = do { local (*DH); }; - ($dirname = $filename) =~ s|/[^/]+$||; - $filename =~ s|.*/||; - - 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; - foreach (readdir($dh)) { - - if (/^${glob}$/) { - push (@results, "$dirname/" . $_); - } - } - closedir($dh); - } - - @results; +# +# Sends a redirect to the given URL. +# +sub redirect($;$) +{ + my ($url, $permanent) = @_; + my ($status, $text); + if ($permanent) { + $status = '301'; + $text = 'Moved Permanently'; + } else { + $status = '302'; + $text = 'Found'; + } + print "Status: $status $text\r\n", "Location: $url\r\n"; + html_header($text); + print "

This document has moved ", &link('here', $url), ".

\n"; + html_footer(); + exit(1); } -sub search_path($) { - my ($command) = @_; - my $d; - for $d (split (/:/, $command_path)) { - return "$d/$command" if -x "$d/$command"; - } +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; } -sub getMimeTypeFromSuffix($) { - my ($fullname) = @_; - my ($mimetype, $suffix); - my $fh = do { local (*FH); }; - ($suffix = $fullname) =~ s/^.*\.([^.]*)$/$1/; - $mimetype = $MTYPES{$suffix}; - $mimetype = $MTYPES{'*'} if (!$mimetype); - - if (!$mimetype && -f $mime_types) { - - # okey, this is something special - search the - # mime.types database - open($fh, "<$mime_types"); - while (<$fh>) { - if ($_ =~ /^\s*(\S+\/\S+).*\b$suffix\b/) { - $mimetype = $1; - last; - } - } - close($fh); - } - - # okey, didn't find anything useful .. - if (!($mimetype =~ /\S\/\S/)) { - $mimetype = "text/plain"; - } - return $mimetype; +# +# Searches @command_path for the given executable file. +# +sub search_path($) +{ + my ($command) = @_; + for my $d (@command_path) { + my $cmd = catfile($d, $command); + return $cmd if (-x $cmd && !-d _); + } + return ''; } + +# +# Gets the enscript(1) highlight mode corresponding to the given filename, +# or undef if unsupported. +# +sub getEnscriptHL($) +{ + return undef unless $allow_enscript; + my ($filename) = @_; + while (my ($hl, $regex) = each %enscript_types) { + return $hl if ($filename =~ $regex); + } + return undef; +} + + +# +# Gets the MIME type for the given file name. +# +sub getMimeType($;$) +{ + my ($fullname, $binary) = @_; + $binary = ($keywordsubstitution && $keywordsubstitution =~ /b/) + unless defined($binary); + + (my $suffix = $fullname) =~ s/^.*\.([^.]*)$/$1/; + + my $mimetype = $MTYPES{$suffix}; + $mimetype ||= $MimeTypes->mimeTypeOf($fullname) if defined($MimeTypes); + + if (!$mimetype && $suffix ne '*' && -f $mime_types && -r _) { + my $fh = do { local (*FH); }; + if (open($fh, $mime_types)) { + my $re = sprintf('^\s*(\S+\/\S+)\s.+\b%s\b', quotemeta($suffix)); + $re = qr/$re/; + while (my $line = <$fh>) { + if ($line =~ $re) { + $mimetype = $1; + $MTYPES{$suffix} = $mimetype; + last; + } + } + close($fh); + } else { + warn("Can't open MIME types file $mime_types for reading: $!"); + } + } + + $mimetype ||= $MTYPES{'*'}; + $mimetype ||= $binary ? 'application/octet-stream' : 'text/plain'; + return $mimetype; +} + + ############################### # read first lines like head(1) ############################### -sub head($;$) { - my $fh = $_[0]; - my $linecount = $_[1] || 10; +sub head($;$) +{ + my ($fh, $linecount) = @_; + $linecount ||= 10; - my @buf; - - if ($linecount > 0) { - my $i; - for ($i = 0 ; !eof($fh) && $i < $linecount ; $i++) { - push @buf, scalar <$fh>; - } - } else { - @buf = <$fh>; - } - - @buf; + my @buf; + if ($linecount > 0) { + for (my $i = 0; !eof($fh) && $i < $linecount; $i++) { + push @buf, scalar <$fh>; + } + } else { + @buf = <$fh>; + } + return @buf; } + ############################### # scan vim and Emacs directives ############################### -sub scan_directives(@) { - my $ts = undef; +sub scan_directives(@) +{ + my $ts = undef; - for (@_) { - $ts = $1 if /\b(?:ts|tabstop|tab-width)[:=]\s*([1-9]\d*)\b/; - } + for (@_) { + $ts = $1 if /\b(?:ts|tabstop|tab-width)[:=]\s*([1-9]\d*)\b/; + } - ('tabstop' => $ts); + ('tabstop' => $ts); } -sub openOutputFilter() { - return if !defined($output_filter) || $output_filter eq ''; - open(STDOUT, "|-") and return; +sub openOutputFilter() +{ + return unless $output_filter; - # child of child - open(STDERR, '>/dev/null'); - exec($output_filter) or exit -1; + open(STDOUT, "|-") and return; + + # child of child + open(STDERR, '>', devnull()) unless $DEBUG; + exec($output_filter) or exit -1; } + ############################### # show Annotation ############################### -sub doAnnotate($$) { - my ($rev) = @_; - my ($pid); - my ($pathname, $filename); - my $reader = do { local (*FH); }; - my $writer = do { local (*FH); }; +sub doAnnotate($$) +{ + my ($rev, $tag) = @_; + $rev = $tag || 'HEAD' if ($rev eq '.'); + (my $pathname = $where) =~ s|((?<=/)Attic/)?[^/]*$||; + (my $filename = $where) =~ s|^.*/||; - # make sure the revisions are wellformed, for security - # reasons .. - if ($rev =~ /[^\w.]/) { - fatal("404 Not Found", - 'Malformed query "%s"', - $ENV{QUERY_STRING}); - } + # This annotate version is based on the cvs annotate-demo Perl script by + # Cyclic Software. It was written by Cyclic Software, + # http://www.cyclic.com/, and is in the public domain. + # We could abandon the use of rlog, rcsdiff and co using + # the cvs server in a similiar way one day (..after rewrite). - ($pathname = $where) =~ s/(Attic\/)?[^\/]*$//; - ($filename = $where) =~ s/^.*\///; + local (*CVS_IN, *CVS_OUT); + my $annotate_err; + my ($h, $err) = + startproc([ $CMD{cvs}, @annotate_options, 'server' ], + 'pipe', \*CVS_OUT, + '2>', \$annotate_err); + fatal('500 Internal Error', + 'Annotate failure (exit status %s), output:
%s
', + $? >> 8 || -1, $err) + unless $h; - # this seems to be necessary - $| = 1; - $| = 0; # Flush + # OK, first send the request to the server. A simplified example is: + # Root /home/kingdon/zwork/cvsroot + # Argument foo/xx + # Directory foo + # /home/kingdon/zwork/cvsroot/foo + # Directory . + # /home/kingdon/zwork/cvsroot + # annotate + # although as you can see there are a few more details. - # Work around a mod_perl bug (?) in order to make open2() work. - # Search for "untie STDIN" in mod_perl mailing list archives. - my $old_stdin; - if ($is_mod_perl && ($old_stdin = tied *STDIN)) { - local $^W = undef; - untie *STDIN; - } + print CVS_IN "Root $cvsroot\n"; + print CVS_IN + "Valid-responses ok error Valid-requests Checked-in Updated Merged Removed M E\n"; - # this annotate version is based on the - # cvs annotate-demo Perl script by Cyclic Software - # It was written by Cyclic Software, http://www.cyclic.com/, and is in - # the public domain. - # we could abandon the use of rlog, rcsdiff and co using - # the cvsserver in a similiar way one day (..after rewrite) - $pid = open2($reader, $writer, $CMD{cvs}, @annotate_options, 'server') - or fatal("500 Internal Error", - 'Fatal Error - unable to open cvs for annotation'); + # Don't worry about sending valid-requests, the server just needs to + # support "annotate" and if it doesn't, there isn't anything to be done. + print CVS_IN "UseUnchanged\n"; + print CVS_IN "Argument -r\n"; + print CVS_IN "Argument $rev\n"; + print CVS_IN "Argument $where\n"; - # Re-tie STDIN if we fiddled around with it earlier, just to be sure. - tie(*STDIN, ref($old_stdin), $old_stdin) if ($old_stdin && !tied(*STDIN)); + # The protocol requires us to fully fake a working directory (at + # least to the point of including the directories down to the one + # containing the file in question). + # So if $where is "dir/sdir/file", then dirs will be ("dir","sdir","file") + my $path = ''; + foreach my $dir (split('/', $where)) { - # OK, first send the request to the server. A simplified example is: - # Root /home/kingdon/zwork/cvsroot - # Argument foo/xx - # Directory foo - # /home/kingdon/zwork/cvsroot/foo - # Directory . - # /home/kingdon/zwork/cvsroot - # annotate - # although as you can see there are a few more details. + if ($path eq "") { + # In our example, $dir is "dir". + $path = $dir; + } else { + print CVS_IN "Directory $path\n"; + print CVS_IN "$cvsroot/$path\n"; - print $writer "Root $cvsroot\n"; - print $writer - "Valid-responses ok error Valid-requests Checked-in Updated Merged Removed M E\n"; + # In our example, $_ is "sdir" and $path becomes "dir/sdir" + # And the next time, "file" and "dir/sdir/file" (which then gets + # ignored, because we don't need to send Directory for the file). + $path .= "/$dir"; + } + } + undef $path; - # Don't worry about sending valid-requests, the server just needs to - # support "annotate" and if it doesn't, there isn't anything to be done. - print $writer "UseUnchanged\n"; - print $writer "Argument -r\n"; - print $writer "Argument $rev\n"; - print $writer "Argument $where\n"; + # And the last "Directory" before "annotate" is the top level. + print CVS_IN "Directory .\n"; + print CVS_IN "$cvsroot\n"; - # The protocol requires us to fully fake a working directory (at - # least to the point of including the directories down to the one - # containing the file in question). - # So if $where is "dir/sdir/file", then @dirs will be ("dir","sdir","file") - my @dirs = split ('/', $where); - my $path = ""; - foreach (@dirs) { + print CVS_IN "annotate\n"; - if ($path eq "") { + # OK, we've sent our command to the server. Thing to do is to + # close the writer side and get all the responses. + if (!close(CVS_IN)) { + $h->finish(); + fatal('500 Internal Error', + 'Annotate failure (exit status %s): %s, output: ' . + '
%s
', $? >> 8, $!, $annotate_err); + } - # In our example, $_ is "dir". - $path = $_; - } else { - print $writer "Directory $path\n"; - print $writer "$cvsroot/$path\n"; + navigateHeader($scriptwhere, $pathname, $filename, $rev, 'annotate'); - # In our example, $_ is "sdir" and $path becomes "dir/sdir" - # And the next time, "file" and "dir/sdir/file" (which then gets - # ignored, because we don't need to send Directory for the file). - $path .= "/$_"; - } - } + my $revtype = ($rev =~ /\./) ? 'revision' : 'tag'; # TODO: tag -> branch/tag? + print '

Annotation of ', + htmlquote("$pathname$filename"), ", $revtype $rev

\n"; - # And the last "Directory" before "annotate" is the top level. - print $writer "Directory .\n"; - print $writer "$cvsroot\n"; + # Ready to get the responses from the server. + # For example: + # E Annotations for foo/xx + # E *************** + # M 1.3 (kingdon 06-Sep-97): hello + # ok + my ($lineNr) = 0; + my ($oldLrev, $oldLusr) = ("", ""); + my ($revprint, $usrprint); - print $writer "annotate\n"; + if ($annTable) { + print < +EOF + } else { + print "
";
+  }
 
-	# OK, we've sent our command to the server.  Thing to do is to
-	# close the writer side and get all the responses.  If "cvs server"
-	# were nicer about buffering, then we could just leave it open, I think.
-	close($writer) or die "cannot close: $!";
+  # prefetch several lines
+  my @buf = head(*CVS_OUT);
 
-	http_header();
+  my %d = scan_directives(@buf);
 
-	navigateHeader($scriptwhere, $pathname, $filename, $rev, "annotate");
-	print
-	    "

Annotation of $pathname$filename, Revision $rev

\n"; + while (@buf || !eof(*CVS_OUT)) { - # Ready to get the responses from the server. - # For example: - # E Annotations for foo/xx - # E *************** - # M 1.3 (kingdon 06-Sep-97): hello - # ok - my ($lineNr) = 0; - my ($oldLrev, $oldLusr) = ("", ""); - my ($revprint, $usrprint); + $_ = @buf ? shift @buf : ; + my @words = split; - if ($annTable) { - print "\n"; - } else { - print "
";
-	}
+    # Adding one is for the (single) space which follows $words[0].
+    my $rest = substr($_, length($words[0]) + 1);
+    if ($words[0] eq "E") {
+      next;
+    } elsif ($words[0] eq "M") {
+      $lineNr++;
+      (my $lrev = substr($_, 2,  13)) =~ y/ //d;
+      (my $lusr = substr($_, 16, 9))  =~ y/ //d;
+      my $line = substr($_, 36);
+      # TODO: this does not work for branch/tag revisions.
+      my $isCurrentRev = ($rev eq $lrev);
 
-	# prefetch several lines
-	my @buf = head($reader);
+      # we should parse the date here ..
+      if ($lrev eq $oldLrev) {
+        $revprint = sprintf('%-8s', '');
+      } else {
+        $revprint = sprintf('%-8s', $lrev);
+        $revprint =~ s|(\S+)|&link($1, uri_escape($filename)."$query#rev$1")|e;
+        $oldLusr = '';
+      }
 
-	my %d = scan_directives(@buf);
+      $usrprint = ($lusr eq $oldLusr) ? '' : $lusr;
+      $oldLrev = $lrev;
+      $oldLusr = $lusr;
 
-	while (@buf || !eof($reader)) {
-		$_ = @buf ? shift @buf : <$reader>;
+      print $is_textbased ? '' : ''
+        if $isCurrentRev;
 
-		my @words = split;
+      $usrprint = sprintf('%-8s', $usrprint);
+      printf '%s%s %s %4d:', $revprint, $isCurrentRev ? '!' : ' ',
+        htmlquote($usrprint), $lineNr;
+      print spacedHtmlText($line, $d{tabstop});
 
-		# Adding one is for the (single) space which follows $words[0].
-		my $rest = substr($_, length($words[0]) + 1);
-		if ($words[0] eq "E") {
-			next;
-		} elsif ($words[0] eq "M") {
-			$lineNr++;
-			(my $lrev = substr($_, 2,  13)) =~ y/ //d;
-			(my $lusr = substr($_, 16, 9))  =~ y/ //d;
-			my $line = substr($_, 36);
-			my $isCurrentRev = ($rev eq $lrev);
+      print $is_textbased ? '' : '' if $isCurrentRev;
 
-			# we should parse the date here ..
-			if ($lrev eq $oldLrev) {
-				$revprint = sprintf('%-8s', '');
-			} else {
-				$revprint = sprintf('%-8s', $lrev);
-				$revprint =~
-				    s`\S+`&link($&, "$scriptwhere$query#rev$&")`e
-				    ;    # `
-				$oldLusr = '';
-			}
+    } elsif ($words[0] eq "ok") {
+      # We could complain about any text received after this, like the
+      # CVS command line client.  But for simplicity, we don't.
 
-			if ($lusr eq $oldLusr) {
-				$usrprint = '';
-			} else {
-				$usrprint = $lusr;
-			}
-			$oldLrev = $lrev;
-			$oldLusr = $lusr;
+    } elsif ($words[0] eq "error") {
+      fatal("500 Internal Error",
+            'Error occured during annotate: %s', $_);
+    }
+  }
+  $h->finish();
 
-			# Set bold for text-based browsers only - graphical
-			# browsers show bold fonts a bit wider than regular fonts,
-			# so it looks irregular.
-			print "" if ($isCurrentRev && $is_textbased);
-
-			printf "%s%s %-8s %4d:", $revprint,
-			    $isCurrentRev ? '!' : ' ', $usrprint, $lineNr;
-			print spacedHtmlText($line, $d{'tabstop'});
-
-			print "" if ($isCurrentRev && $is_textbased);
-		} elsif ($words[0] eq "ok") {
-
-			# We could complain about any text received after this, like the
-			# CVS command line client.  But for simplicity, we don't.
-		} elsif ($words[0] eq "error") {
-			fatal("500 Internal Error",
-			      'Error occured during annotate: %s',
-			      $_);
-		}
-	}
-
-	if ($annTable) {
-		print "
"; - } else { - print "
"; - } - html_footer(); - - close($reader) or warn "cannot close: $!"; - wait; + if ($annTable) { + print ""; + } else { + print ""; + } + html_footer(); } ############################### # make Checkout ############################### -sub doCheckout($$) { - my ($fullname, $rev) = @_; - my ($mimetype, $revopt); - my $fh = do { local (*FH); }; +sub doCheckout($$$) +{ + my ($fullname, $rev, $tag) = @_; + $rev = $tag || undef if (!$rev || $rev eq '.'); - if ($rev eq 'HEAD' || $rev eq '.') { - $rev = undef; - } + # Start resolving whether we will do a markup view or not. + my $do_markup = undef; + my $want_type = $input{'content-type'}; - # make sure the revisions a wellformed, for security - # reasons .. - if (defined($rev) && $rev =~ /[^\w.]/) { - fatal("404 Not Found", - 'Malformed query "%s"', - $ENV{QUERY_STRING}); - } + # No markup if markup disallowed. + $do_markup = 0 unless $allow_markup; - # get mimetype - if (defined($input{"content-type"}) - && ($input{"content-type"} =~ /\S\/\S/)) - { - $mimetype = $input{"content-type"} - } else { - $mimetype = &getMimeTypeFromSuffix($fullname); - } + # No markup if checkout magic cookie in URL. + $do_markup = 0 if (!defined($do_markup) && $doCheckout); - if (defined($rev)) { - $revopt = "-r$rev"; - if ($use_moddate) { - readLog($fullname, $rev); - $moddate = $date{$rev}; - } - } else { - $revopt = "-rHEAD"; + # Do markup if explicitly asked using cvsweb-markup content type. If the + # asked content type is anything else, no markup. + if (!defined($do_markup) && $want_type) { + if ($want_type =~ CVSWEBMARKUP) { + $want_type = undef; + $do_markup = 1; + } else { + $do_markup = 0; + } + } - if ($use_moddate) { - readLog($fullname); - $moddate = $date{$symrev{HEAD}}; - } - } + # Ok, if $do_markup is still undefined, we know that a download has not been + # explicitly asked. For the last check further down below we'll need to + # know if the file is binary, and possibly run a log on it. + my $needlog = $do_markup || $use_moddate; - ### just for the record: - ### 'cvs co' seems to have a bug regarding single checkout of - ### directories/files having spaces in it; - ### this is an issue that should be resolved on cvs's side - # - # Safely for a child process to read from. - if (!open($fh, "-|")) { # child - # chdir to $tmpdir before to avoid non-readable cgi-bin directories - chdir($tmpdir); - open(STDERR, ">&STDOUT"); # Redirect stderr to stdout + my $moddate = undef; + my $revopt; + if (defined($rev)) { + $revopt = "-r$rev"; + if ($needlog) { + readLog($fullname, $rev); + $moddate = $date{$rev}; + # TODO: even this does not work for branch tags, but only normal tags :( + $moddate ||= $date{$symrev{$rev}} if defined($symrev{$rev}); + } + } else { + $revopt = "-rHEAD"; + if ($needlog) { + readLog($fullname); + $moddate = $date{$symrev{HEAD}}; + } + } - # work around a bug of cvs -p; expand symlinks - use Cwd 'abs_path'; - exec($CMD{cvs}, @cvs_options, - '-d', abs_path($cvsroot), - 'co', '-p', - $revopt, $where) or exit -1; - } + my $cr = abs_path($cvsroot) || $cvsroot; + # abs_path() taints when run as a CGI... + if ($cr =~ VALID_PATH) { + $cr = $1; + } else { + fatal('500 Internal Error', 'Illegal CVS root: %s', $cr); + } + # Use abs_path() to work around a bug of cvs -p; expand symlinks if we can. + my @cmd = ($CMD{cvs}, @cvs_options, '-d', $cr, 'co', '-p', $revopt, $where); - if (eof($fh)) { - fatal("404 Not Found", - '%s is not (any longer) pertinent', - $where); - } + local (*CVS_OUT, *CVS_ERR); + my ($h, $err) = + startproc(\@cmd, \"", '>pipe', \*CVS_OUT, '2>pipe', \*CVS_ERR); + fatal('500 Internal Error', + 'Checkout failure (exit status %s), output:
%s
', + $? >> 8 || -1, $err) + unless $h; - #=================================================================== - #Checking out squid/src/ftp.c - #RCS: /usr/src/CVS/squid/src/ftp.c,v - #VERS: 1.1.1.28.6.2 - #*************** + if (eof(CVS_ERR)) { + $h->finish(); + fatal("404 Not Found", '%s is not (any longer) pertinent', $where); + } - # Parse CVS header - my ($revision, $filename, $cvsheader); - $filename = ""; - while (<$fh>) { - last if (/^\*\*\*\*/); - $revision = $1 if (/^VERS: (.*)$/); + #=================================================================== + #Checking out squid/src/ftp.c + #RCS: /usr/src/CVS/squid/src/ftp.c,v + #VERS: 1.1.1.28.6.2 + #*************** - if (/^Checking out (.*)$/) { - $filename = $1; - $filename =~ s/^\.\/*//; - } - $cvsheader .= $_; - } + # Parse CVS header + my ($revision, $filename, $cvsheader); + $filename = ""; + while () { + last if (/^\*\*\*\*/); + $revision = $1 if (/^VERS: (.*)$/); - if ($filename ne $where) { - fatal("500 Internal Error", - 'Unexpected output from cvs co: %s', - $cvsheader); - } - $| = 1; + if (/^Checking out (.*)$/) { + ($filename = $1) =~ s|^\./+||; + } + $cvsheader .= $_; + } + close(CVS_ERR); - if ($mimetype eq "text/x-cvsweb-markup") { - &cvswebMarkup($fh, $fullname, $revision); - } else { - http_header($mimetype); - print <$fh>; - } - close($fh); + if ($filename ne $where) { + $h->finish(); + fatal("500 Internal Error", + 'Unexpected output from cvs co:
%s
' . + '(expected "%s" but got "%s")', + $cvsheader, $where, $filename); + } + + # Last checks whether we'll do markup or not. + my $isbin = $keywordsubstitution && $keywordsubstitution =~ /b/; + my $mimetype = getMimeType($fullname, $isbin); + + # If we still are not sure whether to do markup or not: + # if the MIME type is "viewable" or this is not a binary file, do. + $do_markup = !$isbin || viewable($mimetype) unless defined($do_markup); + + if ($do_markup) { + + # If this is something we'll be linking to in the markup view, we are + # done with this particular output from "cvs co" and must discard it. + my $linked = $mimetype =~ m{^image/|application/pdf$}i; + if ($linked) { + close(CVS_OUT); + $h->finish(); + } + + # Here we know the last modified date, but don't know if tags have been + # added afterwards (those are shown in the markup view): no last-modified. + cvswebMarkup(\*CVS_OUT, $fullname, $revision, $isbin, $mimetype, $needlog); + + $h->finish() unless $linked; + + } else { + http_header($want_type || $mimetype, $moddate); + local $/ = undef; + print ; + $h->finish(); + } } -sub cvswebMarkup($$$) { - my ($filehandle, $fullname, $revision) = @_; - my ($pathname, $filename); - ($pathname = $where) =~ s/(Attic\/)?[^\/]*$//; - ($filename = $where) =~ s/^.*\///; - my ($fileurl) = urlencode($filename); +sub cvswebMarkup($$$$$$;$) +{ + my ($filehandle, $fullname, $rev, $isbin, $mimetype, $logged, $mod) = @_; - http_header(); + (my $pathname = $where) =~ s|((?<=/)Attic/)?[^/]*$||; + (my $filename = $where) =~ s|^.*/||; - navigateHeader($scriptwhere, $pathname, $filename, $revision, "view"); - print "
"; - print "\n\n\n\n
"; - print "File: ", &clickablePath($where, 1); - print " ("; - &download_link($fileurl, $revision, "download"); - print ")"; + navigateHeader($scriptwhere, $pathname, $filename, $rev, 'view', $mod); - if (!$defaultTextPlain) { - print " ("; - &download_link($fileurl, $revision, "as text", "text/plain"); - print ")"; - } - print "
\n"; + print < +
+File:  +EOF + print &clickablePath($where, 1), "
\n"; - if ($show_log_in_markup) { - readLog($fullname); #,$revision); - printLog($revision, 0); - } else { - print "Version: $revision
\n"; - print "Tag: ", $input{only_with_tag}, "
\n" - if $input{only_with_tag}; - } - print "
"; - my $url = download_url($fileurl, $revision, $mimetype); - print "
"; + if ($show_log_in_markup) { + readLog($fullname) unless $logged; #,$rev); + printLog($rev, $mimetype, $isbin); + } else { + print "Revision: $rev
\n"; + print 'Tag: ', htmlquote($input{only_with_tag}), "
\n" + if $input{only_with_tag}; + } + print "\n
"; + my $url = download_url(uri_escape($filename), $rev, $mimetype); - if ($mimetype =~ /^image/) { - printf '
', hrefquote("$url$barequery"); - } elsif ($mimetype =~ m%^application/pdf%) { - printf '
', - hrefquote("$url$barequery"); - } elsif ($preformat_in_markup) { - print "
";
+  if ($mimetype =~ m|^image/|i) {
+    printf '%s
', + $url . $barequery, htmlquote($filename); + } elsif (lc($mimetype) eq 'application/pdf') { + printf '
', + $url . $barequery; + } else { - # prefetch several lines - my @buf = head($filehandle); + print "
\n";
+    my $linenumbers = $input{ln} || 0;
 
-		my %d = scan_directives(@buf);
+    if (my $enscript_hl = getEnscriptHL($filename)) {
+      doEnscript($filehandle, $enscript_hl, $linenumbers);
 
-		while (@buf || !eof($filehandle)) {
-			$_ = @buf ? shift @buf : <$filehandle>;
+    } else {
+      my $ln  = 0;
+      my @buf = ();
+      my $ts  = undef;
 
-			print spacedHtmlText($_, $d{'tabstop'});
-		}
-		print "
"; - } else { - print "
";
+      if ($preformat_in_markup) {
+        # prefetch several lines
+        @buf = head($filehandle);
+        my %d = scan_directives(@buf);
+        $ts = $d{tabstop};
+      }
 
-		while (<$filehandle>) {
-			print htmlquote($_);
-		}
-		print "
"; - } + while (@buf || !eof($filehandle)) { + $_ = @buf ? shift @buf : <$filehandle>; + if ($linenumbers) { + $ln++; + printf '%5d: ', ($ln) x 2; + } + print $preformat_in_markup ? spacedHtmlText($_, $ts) : htmlquote($_); + } + } + + print "
\n"; + } + html_footer(); } -sub viewable($) { - my ($mimetype) = @_; - $mimetype =~ m%^((text|image)/|application/pdf)%; +sub viewable($) +{ + return shift =~ m{^((text|image)/|application/pdf)}i; } + ############################### # Show Colored Diff ############################### -sub doDiff($$$$$$) { - my ($fullname, $r1, $tr1, $r2, $tr2, $f) = @_; - my $fh = do { local (*FH); }; - my ($rev1, $rev2, $sym1, $sym2, $f1, $f2); +sub doDiff($$$$$$) +{ + my ($fullname, $r1, $tr1, $r2, $tr2, $f) = @_; - if (&forbidden_file($fullname)) { - fatal("403 Forbidden", - 'Access forbidden. This file is mentioned in @ForbiddenFiles'); - return; - } + if (forbidden($fullname)) { + fatal('403 Forbidden', 'Access to %s forbidden.', $where); + } - if ($r1 =~ /([^:]+)(:(.+))?/) { - $rev1 = $1; - $sym1 = $3; - } - if ($r1 eq 'text') { - $rev1 = $tr1; - $sym1 = ""; - } + my ($rev1, $sym1); + if ($r1 =~ /([^:]+)(:(.+))?/) { + $rev1 = $1; + $sym1 = $3; + } + if ($r1 eq 'text') { + $rev1 = $tr1; + $sym1 = ""; + } - if ($r2 =~ /([^:]+)(:(.+))?/) { - $rev2 = $1; - $sym2 = $3; - } - if ($r2 eq 'text') { - $rev2 = $tr2; - $sym2 = ""; - } + my ($rev2, $sym2); + if ($r2 =~ /([^:]+)(:(.+))?/) { + $rev2 = $1; + $sym2 = $3; + } + if ($r2 eq 'text') { + $rev2 = $tr2; + $sym2 = ""; + } - # make sure the revisions a wellformed, for security - # reasons .. - if ($rev1 =~ /[^\w.]/ || $rev2 =~ /[^\w.]/) { - fatal("404 Not Found", - 'Malformed query "%s"', - $ENV{QUERY_STRING}); - } + # + # rev1 and rev2 are now both numeric revisions. + # Thus we do a DWIM here and swap them if rev1 is after rev2. + # XXX should we warn about the fact that we do this? + if (&revcmp($rev1, $rev2) > 0) { + my ($tmp1, $tmp2) = ($rev1, $sym1); + ($rev1, $sym1) = ($rev2, $sym2); + ($rev2, $sym2) = ($tmp1, $tmp2); + } - # - # rev1 and rev2 are now both numeric revisions. - # Thus we do a DWIM here and swap them if rev1 is after rev2. - # XXX should we warn about the fact that we do this? - if (&revcmp($rev1, $rev2) > 0) { - my ($tmp1, $tmp2) = ($rev1, $sym1); - ($rev1, $sym1) = ($rev2, $sym2); - ($rev2, $sym2) = ($tmp1, $tmp2); - } - my $difftype = $DIFFTYPES{$f}; + my $mimetype = getMimeType($fullname); - if (!$difftype) { - fatal("400 Bad arguments", - 'Diff format %s not understood', - $f); - } + # + # Check for per-MIME type diff commands. + # + my $diffcmd = undef; + if (my $diffcmds = $DIFF_COMMANDS{lc($mimetype)}) { + if ($f =~ /^ext(\d*)$/) { + my $n = $1 || 0; + $diffcmd = $diffcmds->[$n]; + } + } + if ($diffcmd && $diffcmd->{cmd} && $diffcmd->{name}) { - my @difftype = @{$difftype->{'opts'}}; - my $human_readable = $difftype->{'colored'}; + if ($diffcmd->{args} && ref($diffcmd->{args}) ne 'ARRAY') { + fatal('500 Internal Error', + 'Configuration error: arguments to external diff tools must ' . + 'be given as array refs. See "%s" in ' . + '%%DIFF_COMMANDS.', + $diffcmd->{name}); + } - # apply special options - if ($showfunc) { - push @difftype, '-p' if $f ne 's'; + (my $cvsname = $where) =~ s/\.diff$//; - my ($re1, $re2); + # Create two temporary files with the two revisions + my $temp_fn1 = checkout_to_temp($cvsroot, $cvsname, $rev1); + my $temp_fn2 = checkout_to_temp($cvsroot, $cvsname, $rev2); - while (($re1, $re2) = each %funcline_regexp) { - if ($fullname =~ /$re1/) { - push @difftype, '-F', $re2; - last; - } - } - } + # Execute chosen diff binary. + local (*DIFF_OUT); + my @cmd = ($diffcmd->{cmd}); + push(@cmd, @{$diffcmd->{args}}) if $diffcmd->{args}; + push(@cmd, $temp_fn1, $temp_fn2); + my ($h, $err) = startproc(\@cmd, \"", '>pipe', \*DIFF_OUT); + if (!$h) { + unlink($temp_fn1); + unlink($temp_fn2); + fatal('500 Internal Error', + 'Diff failure (exit status %s), output:
%s
', + $? >> 8 || -1, $err); + } - if ($human_readable) { - if ($hr_ignwhite) { - push @difftype, '-w'; - } - if ($hr_ignkeysubst) { - push @difftype, '-kk'; - } - } + http_header($diffcmd->{type} || 'text/plain'); + local $/ = undef; + print ; + $h->finish(); + unlink($temp_fn1); + unlink($temp_fn2); - if (!open($fh, "-|")) { # child - open(STDERR, ">&STDOUT"); # Redirect stderr to stdout - openOutputFilter(); - exec($CMD{rcsdiff}, @difftype, "-r$rev1", "-r$rev2", $fullname) or exit -1; - } - if ($human_readable) { - http_header(); - &human_readable_diff($fh, $rev2); - html_footer(); - gzipclose(); - exit; - } else { - http_header("text/plain"); - } + exit; + } - # - #=================================================================== - #RCS file: /home/ncvs/src/sys/netinet/tcp_output.c,v - #retrieving revision 1.16 - #retrieving revision 1.17 - #diff -c -r1.16 -r1.17 - #*** /home/ncvs/src/sys/netinet/tcp_output.c 1995/11/03 22:08:08 1.16 - #--- /home/ncvs/src/sys/netinet/tcp_output.c 1995/12/05 17:46:35 1.17 - # - # Ideas: - # - nuke the stderr output if it's what we expect it to be - # - Add "no differences found" if the diff command supplied no output. - # - #*** src/sys/netinet/tcp_output.c 1995/11/03 22:08:08 1.16 - #--- src/sys/netinet/tcp_output.c 1995/12/05 17:46:35 1.17 RELENG_2_1_0 - # (bogus example, but...) - # - if (grep { $_ eq '-u' } @difftype) { - $f1 = '---'; - $f2 = '\+\+\+'; - } else { - $f1 = '\*\*\*'; - $f2 = '---'; - } + # + # Normal CVS diff. + # - while (<$fh>) { - if (m|^$f1 $cvsroot|o) { - s|$cvsroot/||o; - if ($sym1) { - chop; - $_ .= " $sym1\n"; - } - } elsif (m|^$f2 $cvsroot|o) { - s|$cvsroot/||o; + $f = $DEFAULTVALUE{f} || 'u' if ($f =~ /^ext\d*$/); + my $difftype = $DIFFTYPES{$f}; + if (!$difftype) { + fatal("400 Bad arguments", 'Diff format %s not understood', $f); + } - if ($sym2) { - chop; - $_ .= " $sym2\n"; - } - } - print $_; - } - close($fh); + my @difftype = @{$difftype->{opts}}; + my $human_readable = $difftype->{colored}; + + # Apply special diff options. -p and -F are not available with side by side + # diffs and may cause problems with older (< 2.8) versions of diffutils if + # used with --side-by-side. + if ($showfunc && $f !~ /^s/) { + push(@difftype, '-p'); + while (my ($re1, $re2) = each %funcline_regexp) { + if ($fullname =~ $re1) { + push(@difftype, '-F', $re2); + last; + } + } + } + + if ($human_readable) { + push(@difftype, '-w') if $hr_ignwhite; + push(@difftype, '-kk') if $hr_ignkeysubst; + } + + my $fh = do { local (*FH); }; + if (!open($fh, "-|")) { # child + open(STDERR, ">&STDOUT"); # Redirect stderr to stdout + openOutputFilter(); + exec($CMD{rcsdiff}, @rcsdiff_options, @difftype, "-r$rev1", "-r$rev2", + $fullname) or exit -1; + } + + if ($human_readable) { + # + # Human readable diff. + # + human_readable_diff($fh, $rev2); + html_footer(); + gzipclose(); + exit; + + } elsif ($f =~ /^([ucs])c$/) { + # + # Enscript colored diff. + # + my $hl = 'diff'; + $hl .= $1 if ($1 eq 'u' || $1 eq 's'); + (my $where_nd = $where) =~ s/\.diff$//; + (my $pathname = $where_nd) =~ s|((?<=/)Attic/)?[^/]*$||; + (my $filename = $where_nd) =~ s|^.*/||; + (my $swhere = $scriptwhere) =~ s|\.diff$||; + navigateHeader($swhere, $pathname, $filename, $rev2, 'diff'); + printf(<Diff for /%s between versions %s and %s +
+EOF
+    doEnscript(\$fh, $hl, 0, 'cvsweb_diff');
+    print <
+
+
+EOF + printDiffSelectStickyVars(); + print 'Diff format: '; + printDiffSelect($use_java_script); + print "\n
\n"; + html_footer(); + gzipclose(); + exit; + + } else { + # + # Plain diff. + # + http_header("text/plain"); + } + + # + #=================================================================== + #RCS file: /home/ncvs/src/sys/netinet/tcp_output.c,v + #retrieving revision 1.16 + #retrieving revision 1.17 + #diff -c -r1.16 -r1.17 + #*** /home/ncvs/src/sys/netinet/tcp_output.c 1995/11/03 22:08:08 1.16 + #--- /home/ncvs/src/sys/netinet/tcp_output.c 1995/12/05 17:46:35 1.17 + # + # Ideas: + # - nuke the stderr output if it's what we expect it to be + # - Add "no differences found" if the diff command supplied no output. + # + #*** src/sys/netinet/tcp_output.c 1995/11/03 22:08:08 1.16 + #--- src/sys/netinet/tcp_output.c 1995/12/05 17:46:35 1.17 RELENG_2_1_0 + # (bogus example, but...) + # + my ($f1, $f2); + if (grep { $_ eq '-u' } @difftype) { + $f1 = '---'; + $f2 = '\+\+\+'; + } else { + $f1 = '\*\*\*'; + $f2 = '---'; + } + + while (<$fh>) { + if (m|^$f1 $cvsroot|o) { + s|$cvsroot/||o; + if ($sym1) { + chop; + $_ .= " $sym1\n"; + } + } elsif (m|^$f2 $cvsroot|o) { + s|$cvsroot/||o; + + if ($sym2) { + chop; + $_ .= " $sym2\n"; + } + } + print $_; + } + close($fh); } + ############################### # Show Logs .. ############################### -sub getDirLogs($$@) { - my ($cvsroot, $dirname, @otherFiles) = @_; - my ($state, $otherFiles, $tag, $file, $date, $branchpoint, $branch, - $log); - my ($rev, $revision, $revwanted, $filename, $head, $author); +sub getDirLogs($$@) +{ + my ($cvsroot, $dirname, @otherFiles) = @_; + my $tag = $input{only_with_tag}; + my $DirName = catdir($cvsroot, $where); - $tag = $input{only_with_tag}; + my @files = &safeglob("$DirName/*,v"); + push (@files, &safeglob("$DirName/Attic/*,v")) unless $input{hideattic}; + foreach my $file (@otherFiles) { + push(@files, catfile($DirName, $file)); + } - my ($DirName) = "$cvsroot/$where"; - my (@files, @filetags); - my $fh = do { local (*FH); }; + # Weed out unreadable files. + my $i = 0; + my @unreadable = (); + while ($i < scalar(@files)) { + # Note: last modified files from subdirs returned by + # findLastModifiedSubdirs() come without the ,v suffix so they're not + # found here, but have already been checked for readability. *cough* + if (-r $files[$i] || !-e _) { + $i++; + } else { + push(@unreadable, splice(@files, $i, 1)); + } + } - push (@files, &safeglob("$DirName/*,v")); - push (@files, &safeglob("$DirName/Attic/*,v")) - if (!$input{'hideattic'}); - foreach my $file (@otherFiles) { - push (@files, "$DirName/$file"); - } + # If there are no files, we're done. + return @unreadable unless @files; - # just execute rlog if there are any files - if ($#files < 0) { - return; - } + my @cmd = ($CMD{rlog}); + # Can't use -r as '-' is allowed in tagnames, + # but misinterpreted by rlog. + push(@cmd, '-r') unless defined($tag); - if (defined($tag)) { + my $fh = do { local (*FH); }; + if (!open($fh, '-|')) { # Child + open(STDERR, '>', devnull()) unless $DEBUG; # Ignore rlog's complaints. + openOutputFilter(); + if ($file_list_len && $file_list_len > 1) { + while (scalar(@files) > $file_list_len) { # Process files in chunks. + system(@cmd, splice(@files, 0, $file_list_len)) == 0 or exit -1; + } + } + exec(@cmd, @files) or exit -1; + } + undef @cmd; - #can't use -r as - is allowed in tagnames, but misinterpreated by rlog.. - if (!open($fh, "-|")) { # child - open(STDERR, '>/dev/null'); # rlog may complain; ignore. - openOutputFilter(); - exec($CMD{rlog}, @files) or exit -1; - } - } else { + my $state = 'start'; + my ($date, $branchpoint, $branch, $log, @filetags); + my ($rev, $revision, $revwanted, $filename, $head, $author, $keywordsubst); - if (!open($fh, "-|")) { # child - open(STDERR, '>/dev/null'); # rlog may complain; ignore. - openOutputFilter(); - exec($CMD{rlog}, '-r', @files) or exit -1; - } - } - $state = "start"; + while (<$fh>) { + if ($state eq "start") { - while (<$fh>) { - if ($state eq "start") { + #Next file. Initialize file variables + $rev = ''; + $revwanted = ''; + $branch = ''; + $branchpoint = ''; + $filename = ''; + $log = ''; + $revision = ''; + %symrev = (); + @filetags = (); + $keywordsubst= ''; - #Next file. Initialize file variables - $rev = ''; - $revwanted = ''; - $branch = ''; - $branchpoint = ''; - $filename = ''; - $log = ''; - $revision = ''; - %symrev = (); - @filetags = (); + #jump to head state + $state = "head"; + } - #jump to head state - $state = "head"; - } - print "$state:$_" if ($verbose); - again: + again: - if ($state eq "head") { + if ($state eq "head") { - #$rcsfile = $1 if (/^RCS file: (.+)$/); #not used (yet) + #$rcsfile = $1 if (/^RCS file: (.+)$/); #not used (yet) - if (/^Working file: (.+)$/) { - $filename = $1; - } elsif (/^head: (.+)$/) { - $head = $1; - } elsif (/^branch: (.+)$/) { - $branch = $1 - } elsif (/^symbolic names:/) { - $state = "tags"; - ($branch = $head) =~ s/\.\d+$// - if $branch eq ''; - $branch =~ s/(\d+)$/0.$1/; - $symrev{MAIN} = $branch; - $symrev{HEAD} = $branch; - $alltags{MAIN} = 1; - $alltags{HEAD} = 1; - push (@filetags, "MAIN", "HEAD"); - } elsif (/$LOG_REVSEPARATOR/o) { - $state = "log"; - $rev = ''; - $date = ''; - $log = ''; + if (/^Working file: (.+)$/) { + $filename = $1; + } elsif (/^head: (.+)$/) { + $head = $1; + } elsif (/^branch: (.+)$/) { + $branch = $1; + } elsif (/^keyword substitution: (.+)$/) { + $keywordsubst = $1; + } elsif (/^symbolic names:/) { + $state = "tags"; + ($branch = $head) =~ s/\.\d+$// + if $branch eq ''; + $branch =~ s/(\d+)$/0.$1/; + $symrev{MAIN} = $branch; + $symrev{HEAD} = $branch; + $alltags{MAIN} = 1; + $alltags{HEAD} = 1; + push (@filetags, "MAIN", "HEAD"); + } elsif ($_ =~ LOG_REVSEPR) { + $state = "log"; + $rev = ''; + $date = ''; + $log = ''; - # Try to reconstruct the relative filename if RCS spits out a full path - $filename =~ s%^\Q$DirName\E/%%; - } - next; - } + # Try to reconstruct the relative filename if RCS spits out a full path + $filename =~ s%^\Q$DirName\E/%%; + } + next; + } - if ($state eq "tags") { - if (/^\s+([^:]+):\s+([\d\.]+)\s*$/) { - push (@filetags, $1); - $symrev{$1} = $2; - $alltags{$1} = 1; - next; - } elsif (/^\S/) { + if ($state eq "tags") { + if (/^\s+([^:]+):\s+([\d\.]+)\s*$/) { + push (@filetags, $1); + $symrev{$1} = $2; + $alltags{$1} = 1; + next; + } elsif (/^\S/) { - if (defined($tag)) { - if (defined($symrev{$tag}) - || $tag eq "HEAD") - { - $revwanted = - $symrev{$tag eq "HEAD" ? - "MAIN" : $tag}; - ($branch = $revwanted) =~ - s/\b0\.//; - ($branchpoint = $branch) =~ - s/\.?\d+$//; - $revwanted = '' - if ($revwanted ne $branch); - } elsif ($tag ne "HEAD") { - print - "Tag not found, skip this file" - if ($verbose); - $state = "skip"; - next; - } - } + if (defined($tag)) { + if (defined($symrev{$tag}) || $tag eq "HEAD") { + $revwanted = $symrev{$tag eq "HEAD" ? "MAIN" : $tag}; + ($branch = $revwanted) =~ s/\b0\.//; + ($branchpoint = $branch) =~ s/\.?\d+$//; + $revwanted = '' if ($revwanted ne $branch); + } elsif ($tag ne "HEAD") { + $state = "skip"; + next; + } + } - foreach my $tagfound (@filetags) { - $tags{$tagfound} = 1; - } - $state = "head"; - goto again; - } - } + foreach my $tagfound (@filetags) { + $tags{$tagfound} = 1; + } + $state = "head"; + goto again; + } + } - if ($state eq "log") { - if (/$LOG_REVSEPARATOR/o || /$LOG_FILESEPARATOR/o) { + if ($state eq "log") { + if ($_ =~ LOG_REVSEPR || $_ =~ LOG_FILESEPR) { - # End of a log entry. - my $revbranch = $rev; - $revbranch =~ s/\.\d+$//; - print "$filename $rev Wanted: $revwanted ", - "Revbranch: $revbranch Branch: $branch ", - "Branchpoint: $branchpoint\n" - if ($verbose); + # End of a log entry. + my $revbranch = $rev; + $revbranch =~ s/\.\d+$//; - if ($revwanted eq '' && $branch ne '' - && $branch eq $revbranch || !defined($tag)) - { - print - "File revision $rev found for branch $branch\n" - if ($verbose); - $revwanted = $rev; - } + if ($revwanted eq '' && $branch ne '' && $branch eq $revbranch + || !defined($tag)) + { + $revwanted = $rev; + } - if ($revwanted ne '' ? $rev eq $revwanted : - $branchpoint ne '' ? $rev eq $branchpoint : - 0 && ($rev eq $head)) - { # Don't think head is needed here.. - print - "File info $rev found for $filename\n" - if ($verbose); - my @finfo = - ($rev, $date, $log, $author, - $filename); - my ($name); - ($name = $filename) =~ s%/.*%%; - $fileinfo{$name} = [@finfo]; - $state = "done" if ($rev eq $revwanted); - } - $rev = ''; - $date = ''; - $log = ''; - } elsif ($date eq '' - && m|^date:\s+(\d+)/(\d+)/(\d+)\s+(\d+):(\d+):(\d+);| - ) - { - my $yr = $1; + if ($revwanted ne '' + ? $rev eq $revwanted + : $branchpoint ne '' + ? $rev eq $branchpoint + : 0 + && ($rev eq $head)) + { # Don't think head is needed here.. + my @finfo = ($rev, $date, $log, $author, $filename, $keywordsubst); + (my $name = $filename) =~ s%/.*%%; + $fileinfo{$name} = [@finfo]; + $state = "done" if ($rev eq $revwanted); + } + $rev = ''; + $date = ''; + $log = ''; + } elsif ($date eq '' + && m|^date:\s+(\d+)/(\d+)/(\d+)\s+(\d+):(\d+):(\d+);|) + { + my $yr = $1; + $yr -= 1900 if ($yr > 100); # Damn 2-digit year routines :-) + $date = timegm($6, $5, $4, $3, $2 - 1, $yr); + ($author) = /author: ([^;]+)/; + $state = 'log'; + $log = ''; + next; + } elsif ($rev eq '' && /^revision (\d+(?:\.\d+)+).*$/) { + $rev = $1; # .*$ eats up the locker(lockers?) info, if any + next; + } else { + $log .= $_; + } + } - # damn 2-digit year routines :-) - if ($yr > 100) { - $yr -= 1900; - } - $date = - &Time::Local::timegm($6, $5, $4, $3, $2 - 1, - $yr); - ($author) = /author: ([^;]+)/; - $state = "log"; - $log = ''; - next; - } elsif ($rev eq '' && /^revision (\d+(?:\.\d+)+).*$/) { - $rev = $1; # .*$ eats up the locker(lockers?) info, if any - next; - } else { - $log .= $_; - } - } + if ($_ =~ LOG_FILESEPR) { + $state = "start"; + next; + } + } - if (/$LOG_FILESEPARATOR/o) { - $state = "start"; - next; - } - } + my $linesread = $. || 0; + close($fh); - if ($. == 0) { - fatal("500 Internal Error", - 'Failed to spawn GNU rlog on "%s".

Did you set the $command_path in your configuration file correctly ? (Currently "%s"', - join (", ", @files), $command_path); - } - close($fh); + if ($linesread == 0) { + fatal('500 Internal Error', + 'Failed to spawn GNU rlog on "%s".

Did you set the @command_path in your configuration file correctly? (Currently: "%s")', + htmlquote(join(', ', @files)), join(':', @command_path)); + } + + return @unreadable; } -sub readLog($;$) { - my ($fullname, $revision) = @_; - my ($symnames, $head, $rev, $br, $brp, $branch, $branchrev); - my $fh = do { local (*FH); }; - if (defined($revision)) { - $revision = "-r$revision"; - } else { - $revision = ""; - } +sub readLog($;$) +{ + my ($fullname, $revision) = @_; + my ($symnames, $head, $rev, $br, $brp, $branch, $branchrev); - undef %symrev; - undef %revsym; - undef @allrevisions; - undef %date; - undef %author; - undef %state; - undef %difflines; - undef %log; + undef %symrev; + undef %revsym; + undef @allrevisions; + undef %date; + undef %author; + undef %state; + undef %difflines; + undef %log; + $keywordsubstitution = ''; - print("Going to rlog '$fullname'\n") if ($verbose); - if (!open($fh, "-|")) { # child - if ($revision ne '') { - openOutputFilter(); - exec($CMD{rlog}, $revision, $fullname) or exit -1; - } else { - openOutputFilter(); - exec($CMD{rlog}, $fullname) or exit -1; - } - } + my $fh = do { local (*FH); }; + if (!open($fh, "-|")) { # child + openOutputFilter(); + $revision = defined($revision) ? "-r$revision" : ''; + if ($revision =~ /\./) { + # Normal revision, not a branch/tag name. + exec($CMD{rlog}, $revision, $fullname) or exit -1; + } else { + exec($CMD{rlog}, $fullname) or exit -1; + } + } - while (<$fh>) { - print if ($verbose); - if ($symnames) { - if (/^\s+([^:]+):\s+([\d\.]+)/) { - $symrev{$1} = $2; - } else { - $symnames = 0; - } - } elsif (/^head:\s+([\d\.]+)/) { - $head = $1; - } elsif (/^branch:\s+([\d\.]+)/) { - $curbranch = $1; - } elsif (/^symbolic names/) { - $symnames = 1; - } elsif (/^-----/) { - last; - } - } - ($curbranch = $head) =~ s/\.\d+$// if (!defined($curbranch)); + my $curbranch = undef; + while (<$fh>) { + if ($symnames) { + if (/^\s+([^:]+):\s+([\d\.]+)/) { + $symrev{$1} = $2; + next; + } else { + $symnames = 0; + } + } + if (/^head:\s+([\d\.]+)/) { + $head = $1; + } elsif (/^branch:\s+([\d\.]+)/) { + $curbranch = $1; + } elsif (/^symbolic names/) { + $symnames = 1; + } elsif (/^keyword substitution: (.+)$/) { + $keywordsubstitution = $1; + } elsif (/^-----/) { + last; + } + } + ($curbranch = $head) =~ s/\.\d+$// if (!defined($curbranch)); - # each log entry is of the form: - # ---------------------------- - # revision 3.7.1.1 - # date: 1995/11/29 22:15:52; author: fenner; state: Exp; lines: +5 -3 - # log info - # ---------------------------- + # each log entry is of the form: + # ---------------------------- + # revision 3.7.1.1 + # date: 1995/11/29 22:15:52; author: fenner; state: Exp; lines: +5 -3 + # log info + # ---------------------------- - # For a locked revision, the first line after the separator - # becomes smth like - # revision 9.19 locked by: vassilii; + # For a locked revision, the first line after the separator + # becomes smth like + # revision 9.19 locked by: vassilii; - logentry: + logentry: - while (!/$LOG_FILESEPARATOR/o) { - $_ = <$fh>; - last logentry if (!defined($_)); # EOF - print "R:", $_ if ($verbose); - if (/^revision (\d+(?:\.\d+)+)/) { - $rev = $1; - unshift (@allrevisions, $rev); - } elsif (/$LOG_FILESEPARATOR/o || /$LOG_REVSEPARATOR/o) { - next logentry; - } else { + while ($_ !~ LOG_FILESEPR) { + $_ = <$fh>; + last logentry if (!defined($_)); # EOF + if (/^revision (\d+(?:\.\d+)+)/) { + $rev = $1; + unshift(@allrevisions, $rev); + } elsif ($_ =~ LOG_FILESEPR || $_ =~ LOG_REVSEPR) { + next logentry; + } else { - # The rlog output is syntactically ambiguous. We must - # have guessed wrong about where the end of the last log - # message was. - # Since this is likely to happen when people put rlog output - # in their commit messages, don't even bother keeping - # these lines since we don't know what revision they go with - # any more. - next logentry; - } - $_ = <$fh>; - print "D:", $_ if ($verbose); - if ( - m|^date:\s+(\d+)/(\d+)/(\d+)\s+(\d+):(\d+):(\d+);\s+author:\s+(\S+);\s+state:\s+(\S+);\s+(lines:\s+([0-9\s+-]+))?| - ) - { - my $yr = $1; + # The rlog output is syntactically ambiguous. We must + # have guessed wrong about where the end of the last log + # message was. + # Since this is likely to happen when people put rlog output + # in their commit messages, don't even bother keeping + # these lines since we don't know what revision they go with + # any more. + next logentry; + } + $_ = <$fh>; + if ( + m|^date:\s+(\d+)/(\d+)/(\d+)\s+(\d+):(\d+):(\d+);\s+author:\s+(\S+);\s+state:\s+(\S+);\s+(lines:\s+([0-9\s+-]+))?| + ) + { + my $yr = $1; + $yr -= 1900 if ($yr > 100); # Damn 2-digit year routines :-) + $date{$rev} = timegm($6, $5, $4, $3, $2 - 1, $yr); + $author{$rev} = $7; + $state{$rev} = $8; + $difflines{$rev} = $10; + } else { + fatal("500 Internal Error", 'Error parsing RCS output: %s', $_); + } - # damn 2-digit year routines :-) - if ($yr > 100) { - $yr -= 1900; - } - $date{$rev} = - &Time::Local::timegm($6, $5, $4, $3, $2 - 1, $yr); - $author{$rev} = $7; - $state{$rev} = $8; - $difflines{$rev} = $10; - } else { - fatal("500 Internal Error", - 'Error parsing RCS output: %s', - $_); - } - line: + line: + while (<$fh>) { + next line if (/^branches:\s/); + last line if ($_ =~ LOG_FILESEPR || $_ =~ LOG_REVSEPR); + $log{$rev} .= $_; + } + } + close($fh); - while (<$fh>) { - print "L:", $_ if ($verbose); - next line if (/^branches:\s/); - last line - if (/$LOG_FILESEPARATOR/o || /$LOG_REVSEPARATOR/o); - $log{$rev} .= $_; - } - print "E:", $_ if ($verbose); - } - close($fh); - print "Done reading RCS file\n" if ($verbose); + @revorder = reverse sort { revcmp($a, $b) } @allrevisions; - @revorder = reverse sort { revcmp($a, $b) } @allrevisions; - print "Done sorting revisions", join (" ", @revorder), "\n" - if ($verbose); + # + # HEAD is an artificial tag which is simply the highest tag number on the main + # branch, unless there is a branch tag in the RCS file in which case it's the + # highest revision on that branch. Find it by looking through @revorder; it + # is the first commit listed on the appropriate branch. + # This is not neccesary the same revision as marked as head in the RCS file. + my $headrev = $curbranch || "1"; + ($symrev{MAIN} = $headrev) =~ s/(\d+)$/0.$1/; - # - # HEAD is an artificial tag which is simply the highest tag number on the main - # branch, unless there is a branch tag in the RCS file in which case it's the - # highest revision on that branch. Find it by looking through @revorder; it - # is the first commit listed on the appropriate branch. - # This is not neccesary the same revision as marked as head in the RCS file. - my $headrev = $curbranch || "1"; - ($symrev{"MAIN"} = $headrev) =~ s/(\d+)$/0.$1/; + foreach $rev (@revorder) { + if ($rev =~ /^(\S*)\.\d+$/ && $headrev eq $1) { + $symrev{HEAD} = $rev; + last; + } + } + ($symrev{HEAD} = $headrev) =~ s/\.\d+$// unless defined($symrev{HEAD}); - foreach $rev (@revorder) { - if ($rev =~ /^(\S*)\.\d+$/ && $headrev eq $1) { - $symrev{"HEAD"} = $rev; - last; - } - } - ($symrev{"HEAD"} = $headrev) =~ s/\.\d+$// - if (!defined($symrev{"HEAD"})); - print "Done finding HEAD\n" if ($verbose); + # + # Now that we know all of the revision numbers, we can associate + # absolute revision numbers with all of the symbolic names, and + # pass them to the form so that the same association doesn't have + # to be built then. + # + undef @branchnames; + undef %branchpoint; + undef $sel; - # - # Now that we know all of the revision numbers, we can associate - # absolute revision numbers with all of the symbolic names, and - # pass them to the form so that the same association doesn't have - # to be built then. - # - undef @branchnames; - undef %branchpoint; - undef $sel; + foreach (reverse sort keys %symrev) { + $rev = $symrev{$_}; + if ($rev =~ /^((.*)\.)?\b0\.(\d+)$/) { + push (@branchnames, $_); - foreach (reverse sort keys %symrev) { - $rev = $symrev{$_}; - if ($rev =~ /^((.*)\.)?\b0\.(\d+)$/) { - push (@branchnames, $_); + # + # A revision number of A.B.0.D really translates into + # "the highest current revision on branch A.B.D". + # + # If there is no branch A.B.D, then it translates into + # the head A.B . + # + # This reasoning also applies to the main branch A.B, + # with the branch number 0.A, with the exception that + # it has no head to translate to if there is nothing on + # the branch, but I guess this can never happen? + # + # (the code below gracefully forgets about the branch + # if it should happen) + # + $head = defined($2) ? $2 : ""; + $branch = $3; + $branchrev = $head . ($head ne "" ? "." : "") . $branch; + $rev = $head; - # - # A revision number of A.B.0.D really translates into - # "the highest current revision on branch A.B.D". - # - # If there is no branch A.B.D, then it translates into - # the head A.B . - # - # This reasoning also applies to the main branch A.B, - # with the branch number 0.A, with the exception that - # it has no head to translate to if there is nothing on - # the branch, but I guess this can never happen? - # - # (the code below gracefully forgets about the branch - # if it should happen) - # - $head = defined($2) ? $2 : ""; - $branch = $3; - $branchrev = $head . ($head ne "" ? "." : "") . $branch; - my $regex; - $regex = quotemeta $branchrev; - $rev = $head; + my $regex = '^' . quotemeta($branchrev) . '\b'; + $regex = qr/$regex/; - foreach my $r (@revorder) { - if ($r =~ /^${regex}\b/) { - $rev = $branchrev; - last; - } - } - next if ($rev eq ""); + foreach my $r (@revorder) { + if ($r =~ $regex) { + $rev = $branchrev; + last; + } + } + next if ($rev eq ""); - if ($rev ne $head && $head ne "") { - $branchpoint{$head} .= ", " - if ($branchpoint{$head}); - $branchpoint{$head} .= $_; - } - } - $revsym{$rev} .= ", " if ($revsym{$rev}); - $revsym{$rev} .= $_; - $sel .= "\n"; - } - print "Done associating revisions with branches\n" if ($verbose); + if ($rev ne $head && $head ne "") { + $branchpoint{$head} .= ', ' if ($branchpoint{$head}); + $branchpoint{$head} .= $_; + } + } + $revsym{$rev} .= ", " if ($revsym{$rev}); + $revsym{$rev} .= $_; + $sel .= sprintf("\n", + htmlquote($rev), (htmlquote($_)) x 2); + } - my ($onlyonbranch, $onlybranchpoint); - if ($onlyonbranch = $input{'only_with_tag'}) { - $onlyonbranch = $symrev{$onlyonbranch}; - if ($onlyonbranch =~ s/\b0\.//) { - ($onlybranchpoint = $onlyonbranch) =~ s/\.\d+$//; - } else { - $onlybranchpoint = $onlyonbranch; - } + my ($onlyonbranch, $onlybranchpoint); + if ($onlyonbranch = $input{only_with_tag}) { + $onlyonbranch = $symrev{$onlyonbranch}; + if ($onlyonbranch && $onlyonbranch =~ s/\b0\.//) { + ($onlybranchpoint = $onlyonbranch) =~ s/\.\d+$//; + } else { + $onlybranchpoint = $onlyonbranch; + } - if (!defined($onlyonbranch) || $onlybranchpoint eq "") { - fatal("404 Tag not found", - 'Tag %s not defined', - $input{'only_with_tag'}); - } - } + if (!defined($onlyonbranch) || $onlybranchpoint eq "") { + fatal("404 Tag not found", 'Tag "%s" is not defined.', + $input{only_with_tag}); + } + } - undef @revisions; + undef @revisions; - foreach (@allrevisions) { - ($br = $_) =~ s/\.\d+$//; - ($brp = $br) =~ s/\.\d+$//; - next - if ($onlyonbranch && $br ne $onlyonbranch - && $_ ne $onlybranchpoint); - unshift (@revisions, $_); - } + foreach (@allrevisions) { + ($br = $_) =~ s/\.\d+$//; + ($brp = $br) =~ s/\.\d+$//; + next if ($onlyonbranch + && $br ne $onlyonbranch + && $_ ne $onlybranchpoint); + unshift(@revisions, $_); + } - if ($logsort eq "date") { + if ($logsort eq "date") { - # Sort the revisions in commit order an secondary sort on revision - # (secondary sort needed for imported sources, or the first main - # revision gets before the same revision on the 1.1.1 branch) - @revdisplayorder = - sort { $date{$b} <=> $date{$a} || -revcmp($a, $b) } - @revisions; - } elsif ($logsort eq "rev") { + # Sort the revisions in commit order an secondary sort on revision + # (secondary sort needed for imported sources, or the first main + # revision gets before the same revision on the 1.1.1 branch) + @revdisplayorder = + sort { $date{$b} <=> $date{$a} || -revcmp($a, $b) } @revisions; + } elsif ($logsort eq "rev") { - # Sort the revisions in revision order, highest first - @revdisplayorder = reverse sort { revcmp($a, $b) } @revisions; - } else { + # Sort the revisions in revision order, highest first + @revdisplayorder = reverse sort { revcmp($a, $b) } @revisions; + } else { - # No sorting. Present in the same order as rlog / cvs log - @revdisplayorder = @revisions; - } + # No sorting. Present in the same order as rlog / cvs log + @revdisplayorder = @revisions; + } + return $curbranch; } -sub printDiffLinks($$) { - my ($text, $url) = @_; - my @extra; - local $_; - for ($DIFFTYPES{$defaultDiffType}{'colored'} ? qw(u) : qw(h)) { - my $f = $_ eq $defaultDiffType ? '' : $_; +sub getDiffLinks($$$) +{ + my ($url, $mimetype, $isbin) = @_; - push @extra, &link(lc $DIFFTYPES{$_}{'descr'}, "$url&f=$f"); - } - - print &link($text, $url), ' (', join (', ', @extra), ')'; + my @links = (); + if (!$isbin) { # Offer ordinary diff only for non-binary files. + push(@links, &link('preferred', $url)); + for my $difftype ($DIFFTYPES{$defaultDiffType}{colored} ? qw(u) : qw(h)) { + my $f = $difftype eq $defaultDiffType ? '' : $difftype; + push(@links, + &link(htmlquote(lc($DIFFTYPES{$difftype}{descr})), "$url;f=$f")); + } + } + if (my $extdiffs = $DIFF_COMMANDS{lc($mimetype)}) { + for my $i (0 .. scalar(@$extdiffs)-1) { + my $extdiff = $extdiffs->[$i]; + push(@links, &link(htmlquote($extdiff->{name}), "$url;f=ext$i")) + if ($extdiff->{cmd} && $extdiff->{name}); + } + } + return @links; } -sub printLog($;$) { - my ($link, $br, $brp); - ($_, $link) = @_; - ($br = $_) =~ s/\.\d+$//; - ($brp = $br) =~ s/\.?\d+$//; - my ($isDead, $prev); - $link = 1 if (!defined($link)); - $isDead = ($state{$_} eq "dead"); +sub printLog($$$;$$) +{ + # inlogview: 1 if in log view, otherwise in markup view. + ($_, my $mimetype, my $isbin, my $inlogview, my $isSelected) = @_; + (my $br = $_) =~ s/\.\d+$//; + (my $brp = $br) =~ s/\.?\d+$//; - print "

\n"; - if ($link && !$isDead) { - my ($filename); - ($filename = $where) =~ s/^.*\///; - my ($fileurl) = urlencode($filename); - print ""; + print ""; + if (defined($revsym{$_})) { + foreach my $sym (split(", ", $revsym{$_})) { + print ''; + } + } + if ($revsym{$br} && !defined($nameprinted{$br})) { + foreach my $sym (split(", ", $revsym{$br})) { + print ''; + } + $nameprinted{$br} = 1; + } - if (defined($revsym{$_})) { - foreach my $sym (split (", ", $revsym{$_})) { - print ""; - } - } + print "\n Revision $_"; + if (/^1\.1\.1\.\d+$/) { + print " (vendor branch)"; + } - if (defined($revsym{$br}) && $revsym{$br} - && !defined($nameprinted{$br})) - { - foreach my $sym (split (", ", $revsym{$br})) { - print ""; - } - $nameprinted{$br} = 1; - } - print "\n Revision "; - &download_link($fileurl, $_, $_, - $defaultViewable ? "text/x-cvsweb-markup" : undef); + (my $filename = $where) =~ s|^.*/||; + my $fileurl = uri_escape($filename); + undef $filename; - if ($defaultViewable) { - print " / ("; - &download_link($fileurl, $_, "download", $mimetype); - print ")"; - } + my $isDead = ($state{$_} eq 'dead'); + if (!$isDead) { - if (not $defaultTextPlain) { - print " / ("; - &download_link($fileurl, $_, "as text", "text/plain"); - print ")"; - } + print ': ', download_link($fileurl, $_, 'download', $mimetype); - if (!$defaultViewable) { - print " / ("; - &download_link($fileurl, $_, "view", - "text/x-cvsweb-markup"); - print ")"; - } + my @vlinks = (); + push(@vlinks, display_link($fileurl, $_, 'text', 'text/plain')) + unless $isbin; + push(@vlinks, display_link($fileurl, $_, 'markup', 'text/x-cvsweb-markup')) + if ($allow_markup && $inlogview && (!$isbin || viewable($mimetype))); + if (!$isbin && $allow_annotate) { + push(@vlinks, + &link('annotated', + sprintf('%s?annotate=%s%s', $fileurl, $_, $barequery))); + } + print ' - view: ', join(', ', @vlinks) if @vlinks; + undef @vlinks; - if ($allow_annotate) { - print " - "; - print &link( - 'annotate', - sprintf( - '%s/%s?annotate=%s%s', $scriptname, - urlencode($where), $_, - $barequery - ) - ); - } + if (!$isbin && $allow_version_select) { + print ' - '; + if ($isSelected) { + print '[selected for diffs]'; + } else { + print &link('select for diffs', + sprintf('%s?r1=%s%s#rev%s', + $fileurl, $_, $barequery, $_)); + } + } + print ' - ', graph_link('', 'revision graph') + if (!$inlogview && $allow_cvsgraph); + } + print "
\n"; - # Plus a select link if enabled, and this version isn't selected - if ($allow_version_select) { - if ((!defined($input{"r1"}) || $input{"r1"} ne $_)) { - print " - "; - print &link( - '[select for diffs]', - sprintf( - '%s?r1=%s%s', $scriptwhere, - $_, $barequery - ) - ); - } else { - print " - [selected]"; - } - } - } else { - print "Revision $_"; - } + print ''; + if (defined @mytz) { + my ($est) = $mytz[(localtime($date{$_}))[8]]; + print scalar localtime($date{$_}), " $est ("; + } else { + print scalar gmtime($date{$_}), " UTC ("; + } + print readableTime(time() - $date{$_}, 1), ' ago)'; + print ' by ', htmlquote($author{$_}), "
\n"; - if (/^1\.1\.1\.\d+$/) { - print " (vendor branch)"; - } - if (defined @mytz) { - my ($est) = $mytz[(localtime($date{$_}))[8]]; - print ", ", scalar localtime($date{$_}), " $est ("; - } else { - print ", ", scalar gmtime($date{$_}), " UTC ("; - } - print readableTime(time() - $date{$_}, 1), " ago)"; - print " by "; - print "", $author{$_}, "\n"; - print "
Branch: ", $link ? link_tags($revsym{$br}) : $revsym{$br}, - "\n" - if ($revsym{$br}); - print "
CVS Tags: ", $link ? link_tags($revsym{$_}) : $revsym{$_}, - "" - if ($revsym{$_}); - print "
Branch point for: ", - $link ? link_tags($branchpoint{$_}) : $branchpoint{$_}, "\n" - if ($branchpoint{$_}); + printf("Branches: %s
\n", link_tags($revsym{$br})) if $revsym{$br}; + printf("CVS tags: %s
\n", link_tags($revsym{$_})) if $revsym{$_}; + printf("Branch point for: %s
\n", link_tags($branchpoint{$_})) + if $branchpoint{$_}; - # Find the previous revision - my @prevrev = split (/\./, $_); - do { - if (--$prevrev[$#prevrev] <= 0) { + # Find the previous revision + my $prev; + my @prevrev = split(/\./, $_); + do { + if (--$prevrev[$#prevrev] <= 0) { - # If it was X.Y.Z.1, just make it X.Y - pop (@prevrev); - pop (@prevrev); - } - $prev = join (".", @prevrev); - } until (defined($date{$prev}) || $prev eq ""); + # If it was X.Y.Z.1, just make it X.Y + pop (@prevrev); + pop (@prevrev); + } + $prev = join (".", @prevrev); + } until (defined($date{$prev}) || $prev eq ""); - if ($prev ne "") { - if ($difflines{$_}) { - print - "
Changes since $prev: $difflines{$_} lines"; - } - } + if ($isDead) { + print "FILE REMOVED
\n"; + } else { + my %diffrev = (); + $diffrev{$_} = 1; + $diffrev{""} = 1; + my $diff = 'Diff to:'; + my $printed = 0; - if ($isDead) { - print "
FILE REMOVED\n"; - } elsif ($link) { - my %diffrev = (); - $diffrev{$_} = 1; - $diffrev{""} = 1; - print '
'; - my $diff = 'Diff'; + # + # Offer diff to previous revision + if ($prev) { + $diffrev{$prev} = 1; + my $url = + sprintf('%s.diff?r1=%s;r2=%s%s', $fileurl, $prev, $_, $barequery); + if (my @dlinks = getDiffLinks($url, $mimetype, $isbin)) { + print $diff, ' previous ', $prev, ': ', join(', ', @dlinks); + $diff = ';'; $printed = 1; + } + } - # - # Offer diff to previous revision - if ($prev) { - $diffrev{$prev} = 1; + # + # Plus, if it's on a branch, and it's not a vendor branch, + # offer a diff with the branch point. + if ($revsym{$brp} + && !/^1\.1\.1\.\d+$/ + && !defined($diffrev{$brp})) + { + my $url = + sprintf('%s.diff?r1=%s;r2=%s%s', $fileurl, $brp, $_, $barequery); + if (my @dlinks = getDiffLinks($url, $mimetype, $isbin)) { + print $diff, ' branchpoint ', $brp, ': ', join(', ', @dlinks); + $diff = ';'; $printed = 1; + } + } - my $url = - sprintf('%s.diff?r1=%s&r2=%s%s', $scriptwhere, - $prev, $_, $barequery); + # + # Plus, if it's on a branch, and it's not a vendor branch, + # offer to diff with the next revision of the higher branch. + # (e.g. change gets committed and then brought + # over to -stable) + if (/^\d+\.\d+\.\d+/ && !/^1\.1\.1\.\d+$/) { + my ($i, $nextmain); - print $diff, " to previous "; - $diff = ''; - printDiffLinks($prev, $url); - } + for ($i = 0; $i < $#revorder && $revorder[$i] ne $_; $i++) { + } + my @tmp2 = split(/\./, $_); + for ($nextmain = ""; $i > 0; $i--) { + my $next = $revorder[$i - 1]; + my @tmp1 = split(/\./, $next); - # - # Plus, if it's on a branch, and it's not a vendor branch, - # offer a diff with the branch point. - if ($revsym{$brp} && !/^1\.1\.1\.\d+$/ - && !defined($diffrev{$brp})) - { - my $url = - sprintf('%s.diff?r1=%s&r2=%s%s', $scriptwhere, $brp, - $_, $barequery); + if (@tmp1 < @tmp2) { + $nextmain = $next; + last; + } - print $diff, " to branchpoint "; - $diff = ''; - printDiffLinks($brp, $url); - } + # Only the highest version on a branch should have + # a diff for the "next MAIN". + last + if (@tmp1 - 1 <= @tmp2 + && join (".", @tmp1[0 .. $#tmp1 - 1]) eq + join (".", @tmp2[0 .. $#tmp1 - 1])); + } - # - # Plus, if it's on a branch, and it's not a vendor branch, - # offer to diff with the next revision of the higher branch. - # (e.g. change gets committed and then brought - # over to -stable) - if (/^\d+\.\d+\.\d+/ && !/^1\.1\.1\.\d+$/) { - my ($i, $nextmain); + if (!defined($diffrev{$nextmain})) { + $diffrev{$nextmain} = 1; + my $url = sprintf('%s.diff?r1=%s;r2=%s%s', + $fileurl, $nextmain, $_, $barequery); + if (my @dlinks = getDiffLinks($url, $mimetype, $isbin)) { + print $diff, ' next MAIN ', $nextmain, ': ', join(', ', @dlinks); + $diff = ';'; $printed = 1; + } + } + } - for ($i = 0 ; $i < $#revorder && $revorder[$i] ne $_ ; - $i++) - { - } - my @tmp2 = split (/\./, $_); - for ($nextmain = "" ; $i > 0 ; $i--) { - my $next = $revorder[$i - 1]; - my @tmp1 = split (/\./, $next); + # Plus if user has selected only r1, then present a link + # to make a diff to that revision + if (defined($input{r1}) && !defined($diffrev{$input{r1}})) { + $diffrev{$input{r1}} = 1; + my $url = sprintf('%s.diff?r1=%s;r2=%s%s', + $fileurl, $input{r1}, $_, $barequery); + if (my @dlinks = getDiffLinks($url, $mimetype, $isbin)) { + print $diff, ' selected ', $input{r1}, ': ', join(', ', @dlinks); + $diff = ';'; $printed = 1; + } + } - if (@tmp1 < @tmp2) { - $nextmain = $next; - last; - } + print "
\n" if $printed; + } - # Only the highest version on a branch should have - # a diff for the "next main". - last - if (@tmp1 - 1 <= @tmp2 - && join (".", @tmp1[0 .. $#tmp1 - 1]) eq - join (".", @tmp2[0 .. $#tmp1 - 1])); - } + if ($prev ne "" && $difflines{$_}) { + printf "Changes since revision %s: %s lines
\n", + htmlquote($prev), htmlquote($difflines{$_}); + } - if (!defined($diffrev{$nextmain})) { - $diffrev{$nextmain} = 1; - - my $url = - sprintf('%s.diff?r1=%s&r2=%s%s', - $scriptwhere, $nextmain, $_, - $barequery); - - print $diff, " next main "; - $diff = ''; - printDiffLinks($nextmain, $url); - } - } - - # Plus if user has selected only r1, then present a link - # to make a diff to that revision - if (defined($input{"r1"}) && !defined($diffrev{$input{"r1"}})) { - $diffrev{$input{"r1"}} = 1; - - my $url = - sprintf('%s.diff?r1=%s&r2=%s%s', $scriptwhere, - $input{'r1'}, $_, $barequery); - - print $diff, " to selected "; - $diff = ''; - printDiffLinks($input{'r1'}, $url); - } - - } - print "\n

\n
\n";
-	print &htmlify($log{$_}, $allow_log_extra);
-	print "
\n"; + print "
\n";
+  print &htmlify($log{$_}, $allow_log_extra);
+  print "
\n"; } -sub doLog($) { - my ($fullname) = @_; - my ($diffrev, $upwhere, $filename, $backurl); - readLog($fullname); +# +# Generates the HTML view for CvsGraph. +# +sub doGraphView() +{ + (my $pathname = $where) =~ s|[^/]*$||; + (my $filename = $where) =~ s|^.*/||; - html_header("CVS log for $where"); - ($upwhere = $where) =~ s|(Attic/)?[^/]+$||; - ($filename = $where) =~ s|^.*/||; - $backurl = $scriptname . "/" . urlencode($upwhere) . $query; - print "

\n "; - print &link($backicon, "$backurl#$filename"), " Up to ", - &clickablePath($upwhere, 1), "\n

\n"; - print "

\n "; - print &link('Request diff between arbitrary revisions', '#diff'); - print "\n

\n
\n"; + navigateHeader($scriptwhere, $pathname, $filename, undef, 'graph'); - print "

\n"; - if ($curbranch) { - print "Default branch: ", ($revsym{$curbranch} || $curbranch); - } else { - print "No default branch"; - } - print "
\n"; + my $title = 'Revision graph of ' . htmlquote($pathname . $filename); + my $mapname = 'CvsGraphMap'; - if ($input{only_with_tag}) { - print "Current tag: $input{only_with_tag}
\n"; - } - print "

\n"; - - undef %nameprinted; - - for (my $i = 0 ; $i <= $#revdisplayorder ; $i++) { - print "
\n"; - printLog($revdisplayorder[$i]); - } - - print "
\n

\n"; - print "\n"; - print "This form allows you to request diff's between any two\n"; - print "revisions of a file. You may select a symbolic revision\n"; - print "name using the selection box or you may type in a numeric\n"; - print "name using the type-in text box.\n"; - print "\n

\n"; - print - "
\n"; - - foreach (@stickyvars) { - printf('', $_, - $input{$_}) - if (defined($input{$_}) - && ((!defined($DEFAULTVALUE{$_}) - || $input{$_} ne $DEFAULTVALUE{$_}) && $input{$_} ne "")); - } - print "\n\n"; - print "\n"; - print "\n\n"; - print "\n\n"; - print "\n"; - print "\n
"; - print "\n"; - print "\n"; - $diffrev = $revdisplayorder[$#revdisplayorder]; - $diffrev = $input{"r1"} if (defined($input{"r1"})); - print - "
"; - print "\n"; - print "\n"; - $diffrev = $revdisplayorder[0]; - $diffrev = $input{"r2"} if (defined($input{"r2"})); - print - "
\n"; - print "
\n"; - print "
\n"; - print "
\n"; - print "\n"; - print "\n\n"; - print "\n\n\n"; - - if (@branchnames) { - print "\n\n"; - print "\n\n\n"; - } - - foreach (@stickyvars) { - next if ($_ eq "f"); - next if ($_ eq "only_with_tag"); - next if ($_ eq "logsort"); - print "\n" - if (defined($input{$_}) - && (!defined($DEFAULTVALUE{$_}) - || $input{$_} ne $DEFAULTVALUE{$_}) && $input{$_} ne ""); - } - print "\n\n\n"; - print "\n"; - print "\n
"; - print ""; - printDiffSelect($use_java_script); - print "
"; - print ""; - print "\n"; - print "
"; - print "\n"; - print ""; - printLogSortSelect($use_java_script); - print "
\n"; - print "
\n"; - html_footer(); -} - -sub flush_diff_rows($$$$) { - my $j; - my ($leftColRef, $rightColRef, $leftRow, $rightRow) = @_; - - if (!defined($state)) { - return; - } - - if ($state eq "PreChangeRemove") { # we just got remove-lines before - for ($j = 0 ; $j < $leftRow ; $j++) { - print - "\n @$leftColRef[$j]\n"; - print - " \n\n"; - } - } elsif ($state eq "PreChange") { # state eq "PreChange" - # we got removes with subsequent adds - - for ($j = 0 ; $j < $leftRow || $j < $rightRow ; $j++) - { # dump out both cols - print "\n"; - if ($j < $leftRow) { - print - " @$leftColRef[$j]"; - } else { - print - " "; - } - print "\n"; - - if ($j < $rightRow) { - print - " @$rightColRef[$j]"; - } else { - print - " "; - } - print "\n\n"; - } - } -} - -## -# Function to generate Human readable diff-files -# human_readable_diff(String revision_to_return_to); -## -sub human_readable_diff($) { - my ($difftxt, $where_nd, $filename, $pathname, $scriptwhere_nd); - my ($fh, $rev) = @_; - my ($date1, $date2, $r1d, $r2d, $r1r, $r2r, $rev1, $rev2, $sym1, $sym2); - my (@rightCol, @leftCol); - - ($where_nd = $where) =~ s/.diff$//; - ($filename = $where_nd) =~ s/^.*\///; - ($pathname = $where_nd) =~ s/(Attic\/)?[^\/]*$//; - ($scriptwhere_nd = $scriptwhere) =~ s/.diff$//; - - navigateHeader($scriptwhere_nd, $pathname, $filename, $rev, "diff"); - - # Read header to pick up read revision and date, if possible - while (<$fh>) { - ($r1d, $r1r) = /\t(.*)\t(.*)$/ if (/^--- /); - ($r2d, $r2r) = /\t(.*)\t(.*)$/ if (/^\+\+\+ /); - last if (/^\+\+\+ /); - } - - if (defined($r1r) && $r1r =~ /^(\d+\.)+\d+$/) { - $rev1 = $r1r; - $date1 = $r1d; - } - if (defined($r2r) && $r2r =~ /^(\d+\.)+\d+$/) { - $rev2 = $r2r; - $date2 = $r2d; - } - - print - "

Diff for /$where_nd between version $rev1 and $rev2

\n", - # Using style=\"border: none\" here breaks NS 4.x badly... - "\n", - "\n", "\n", "\n"; - - my $leftRow = 0; - my $rightRow = 0; - my ($oldline, $newline, $funname, $diffcode, $rest); - - # Process diff text - - # prefetch several lines - my @buf = head($fh); - - my %d = scan_directives(@buf); - - while (@buf || !eof($fh)) { - $difftxt = @buf ? shift @buf : <$fh>; - - if ($difftxt =~ /^@@/) { - ($oldline, $newline, $funname) = - $difftxt =~ /@@ \-([0-9]+).*\+([0-9]+).*@@(.*)/; - $funname = htmlquote($funname); - $funname =~ s/\s/ /go; - print - "\n\n\n"; - $state = "dump"; - $leftRow = 0; - $rightRow = 0; - } else { - ($diffcode, $rest) = $difftxt =~ /^([-+ ])(.*)/; - $_ = spacedHtmlText($rest, $d{'tabstop'}); - - ######### - # little state machine to parse unified-diff output (Hen, zeller@think.de) - # in order to get some nice 'ediff'-mode output - # states: - # "dump" - just dump the value - # "PreChangeRemove" - we began with '-' .. so this could be the start of a 'change' area or just remove - # "PreChange" - okey, we got several '-' lines and moved to '+' lines -> this is a change block - ########## - - if ($diffcode eq '+') { - if ($state eq "dump") - { # 'change' never begins with '+': just dump out value - print - "\n\n\n\n"; - } else { # we got minus before - $state = "PreChange"; - $rightCol[$rightRow++] = $_; - } - } elsif ($diffcode eq '-') { - $state = "PreChangeRemove"; - $leftCol[$leftRow++] = $_; - } else { # empty diffcode - flush_diff_rows \@leftCol, \@rightCol, $leftRow, - $rightRow; - print "\n\n\n\n"; - $state = "dump"; - $leftRow = 0; - $rightRow = 0; - } - } - } - close($fh); - - flush_diff_rows \@leftCol, \@rightCol, $leftRow, $rightRow; - - # state is empty if we didn't have any change - if (!$state) { - print "\n\n\n"; - print "\n"; - print - "\n\n"; - } - print "
", - "version $rev1"; - print ", $date1" if (defined($date1)); - print "
Tag: $sym1\n" if ($sym1); - print "
", "version $rev2"; - print ", $date2" if (defined($date2)); - print "
Tag: $sym2\n" if ($sym1); - print "
"; - print - "\n\n\n\n
Line $oldline"; - print - " $funname
"; - print "
"; - print - "\n\n\n\n
Line $newline"; - print - " $funname
\n"; - print "
  $_
 $_ $_
 
- No viewable change -
\n"; - - print "
\n"; - print "
\n"; - print "\n\n\n\n"; - - print "\n
\n"; - - # print legend - print "\n\n\n\n
"; - print "Legend:
\n"; - print - "\n\n\n\n"; - print - "\n\n\n"; - print - "\n\n\n\n"; - print "
Removed from v.$rev1 
changed lines
 Added in v.$rev2
\n
\n
"; - - # Print format selector - foreach my $var (keys %input) { - next if ($var eq "f"); - next - if (defined($DEFAULTVALUE{$var}) - && $DEFAULTVALUE{$var} eq $input{$var}); - print "\n"; - } - printDiffSelect($use_java_script); - print "\n"; - print "
\n"; - print "
\n"; -} - -sub navigateHeader($$$$$) { - my ($swhere, $path, $filename, $rev, $title) = @_; - $swhere = "" if ($swhere eq $scriptwhere); - $swhere = './' . urlencode($filename) if ($swhere eq ""); - - # TODO: this should be moved into external CSS file. - my $css = ''; - if ($title eq 'diff') { - $css = " -"; - } - - print < - -$path$filename - $title - $rev$css -$HTML_META -$body_tag_for_src - -"; + # Remove any pre-existing tag/branch names from branch links. + (my $notag_query = $barequery) =~ s/;+only_with_tag=.*?(?=;|$)//g; - print ""; - print "
+ printf(<%s +
%s EOF - print &link($backicon, "$swhere$query#rev$rev"); - print "Return to ", &link($filename, "$swhere$query#rev$rev"), - " CVS log"; - print " $fileicon
$diricon Up to ", - &clickablePath($path, 1), - "
"; + my @graph_cmd = + ($CMD{cvsgraph}, + '-r', $cvsroot, + '-m', $pathname, + '-i', + '-M', $mapname, + '-x', 'x', + "-Omap_branch_href=\"href=\\\"./?only_with_tag=%(%t%)$notag_query\\\"\"", + "-Omap_rev_href=\"href=\\\"?rev=%(%R%)$barequery\\\"\"", + "-Omap_diff_href=\"href=\\\"%(%F%).diff" . + "?r1=%(%P%);r2=%(%R%)$barequery\\\"\"", + ); + push(@graph_cmd, '-c', $cvsgraph_config) if $cvsgraph_config; + push(@graph_cmd, $filename . ',v'); + + local *CVSGRAPH_OUT; + my ($h, $err) = + startproc(\@graph_cmd, \"", '>pipe', \*CVSGRAPH_OUT); + fatal('500 Internal Error', $err) unless $h; + + # Browser compatibility kludge: many browsers do not support client side + # image maps where the element contains only the id attribute. Let's + # add the corresponding name attribute to it on the fly. + while () { + s/(/$1 name="$2">/; + print; + } + + $h->finish(); + print "\n"; + + html_footer(); } -sub plural_write($$) { - my ($num, $text) = @_; - if ($num != 1) { - $text .= "s"; - } - if ($num > 0) { - return join (' ', $num, $text); - } else { - return ""; - } +# +# Generates a graph using CvsGraph. +# +sub doGraph() +{ + (my $pathname = $where) =~ s|[^/]*$||; + (my $filename = $where) =~ s|^.*/||; + + http_header('image/png'); + + my @graph_cmd = ($CMD{cvsgraph}, '-r', $cvsroot, '-m', $pathname); + push(@graph_cmd, '-c', $cvsgraph_config) if $cvsgraph_config; + push(@graph_cmd, $filename . ',v'); + + local *CVSGRAPH_OUT; + my ($h, $err) = + startproc(\@graph_cmd, \"", '>pipe', \*CVSGRAPH_OUT); + fatal('500 Internal Error', $err) unless $h; + { + local $/ = undef; + binmode(\*STDOUT); + print ; + } + $h->finish(); } + +sub doLog($) +{ + my ($fullname) = @_; + + my $curbranch = readLog($fullname); + + html_header("CVS log for $where"); + + my $upwhere = $where; + (my $filename = $where) =~ s|^.*/||; + my $backurl = "./$query#" . uri_escape($filename); + if ($where =~ m|^(.*?)((?<=/)Attic/)?[^/]+$|) { + $upwhere = $1; + $backurl = ".$backurl" if $2; # skip over Attic + } + + my $isbin = $keywordsubstitution =~ /b/; + my $mimetype = getMimeType($filename, $isbin); + + print "

\n "; + print &link($backicon, $backurl), " Up to ", + &clickablePath($upwhere, 1), "\n

\n"; + print "

\n "; + print &link('Request diff between arbitrary revisions', '#diff'); + print ' - ', &graph_link('', 'Display revisions graphically') + if $allow_cvsgraph; + if ($cvshistory_url) { + (my $d = $upwhere) =~ s|/+$||; + print ' - ', history_link($d, $filename); + } + print "\n

\n
\n"; + + print "

\n"; + + my $explain = $isbin ? ' (i.e.: CVS considers this a binary file)' : ''; + print "Keyword substitution: $keywordsubstitution$explain
\n"; + if ($curbranch) { + print "Default branch: ", ($revsym{$curbranch} || $curbranch); + } else { + print "No default branch"; + } + print "
\n"; + + print 'Current tag: ', htmlquote($input{only_with_tag}), "
\n" + if $input{only_with_tag}; + print "

\n"; + + undef %nameprinted; + + for my $r (@revdisplayorder) { + print "
\n"; + my $sel = (defined($input{r1}) && $input{r1} eq $r); + print "
\n" if $sel; + printLog($r, $mimetype, $isbin, 1, $sel); + print "
\n" if $sel; + } + + printf(< +
+
+Diff request +

+ + This form allows you to request diffs between any two revisions of a file. + You may select a symbolic revision name using the selection box or you may + type in a numeric name using the type-in text box. + +

+EOF + + foreach (@stickyvars) { + printf("\n", + $_, htmlquote($input{$_})) + if (defined($input{$_}) && + (!defined($DEFAULTVALUE{$_}) || $input{$_} ne $DEFAULTVALUE{$_})); + } + + print < + + + + + +\n"; + + my $diffrev = defined($input{r1}) ? + $input{r1} : $revdisplayorder[$#revdisplayorder]; + + printf(< + + + + + + + + +\n"; + + $diffrev = defined($input{r2}) ? $input{r2} : $revdisplayorder[0]; + + printf(< + + + + +
+
+
+
+Log view options + + + + + +EOF + + if (@branchnames) { + + printf(< + + + + +EOF + } + + print < + + + +
+ + +EOF + printDiffSelect($use_java_script); + print < +
+ + + +
+ + +EOF + printLogSortSelect($use_java_script); + print < +
+EOF + foreach (@stickyvars) { + next if ($_ eq "f"); + next if ($_ eq "only_with_tag"); + next if ($_ eq "logsort"); + printf("\n", + htmlquote($input{$_})) + if (defined($input{$_}) + && (!defined($DEFAULTVALUE{$_}) || $input{$_} ne $DEFAULTVALUE{$_})); + } + print "
\n
\n"; + html_footer(); +} + + +sub flush_diff_rows($$$$) +{ + my ($leftColRef, $rightColRef, $leftRow, $rightRow) = @_; + + return unless defined($state); + + if ($state eq "PreChangeRemove") { # we just got remove-lines before + for (my $j = 0; $j < $leftRow; $j++) { + printf(< +  %s +   + +EOF + } + } elsif ($state eq "PreChange") { # state eq "PreChange" + # we got removes with subsequent adds + if (HAS_EDIFF) { + # construct the suffix tree + my $left_diff = join("\n", @$leftColRef[0..$leftRow-1]); + my $right_diff = join("\n", @$rightColRef[0..$rightRow-1]); + my $diff_str = String::Ediff::ediff($left_diff, $right_diff); + + my @diff_str = split(/ /, $diff_str); + my $INFINITY = 10000000; + push(@diff_str, ($INFINITY) x 8); + my ($idx, $b1, $e1, $lb1, $le1, $b2, $e2, $lb2, $le2) = + (0, @diff_str[0..7]); + my ($l_cul, $r_cul) = (0, 0); + my ($ldx, $rdx) = (0, 0); + my (@left_html, @right_html); + for (my $j = 0; $j < $leftRow; $j++) { + my $line_len = length(@$leftColRef[$j]); + my $line = @$leftColRef[$j]; + $l_cul += length($line) + 1; # includes "\n" + my $l_culx = $l_cul - 1; # not includes "\n" + if ($j < $lb1) { + $line = spacedHtmlText($line); + push(@left_html, "$line"); + } elsif ($lb1 == $j) { + my $html_line; + while ($lb1 == $j) { + my $begin_char = $l_culx - $b1; + + $line =~ /^(.*)(.{$begin_char})$/; + $html_line .= spacedHtmlText($1) . + ''; + $line = $2; + last if ($j != $le1); + + my $end_char = $l_culx - $e1; + $line =~ /^(.*)(.{$end_char})$/; + $html_line .= spacedHtmlText($1) . + ''; + $line = $2; + + $idx++; + my ($tb1, $te1, $tlb1, $tle1, $tb2, $te2, $tlb2, $tle2) = + ($b1, $e1, $lb1, $le1, $b2, $e2, $lb2, $le2); + ($b1, $e1, $lb1, $le1, $b2, $e2, $lb2, $le2) = + @diff_str[$idx*8..($idx+1)*8-1]; + $lb1 = $INFINITY if ($lb1 < 0); + $lb2 = $INFINITY if ($lb2 < 0); + $le1 = $INFINITY if ($le1 < 0); + $le2 = $INFINITY if ($le2 < 0); + if ($te1 > $b1) { + ($b1, $lb1) = ($te1, $tle1); + } + if ($te2 > $b2) { + ($b2, $lb2) = ($te2, $tle2); + } + } + push(@left_html, + sprintf('%s%s', + $html_line, spacedHtmlText($line))); + } elsif ($le1 == $j) { + my $html_line; + while ($le1 == $j) { + my $end_char = $l_culx - $e1; + $line =~ /^(.*)(.{$end_char})$/; + $html_line .= spacedHtmlText($1) . + ''; + $line = $2; + + $idx++; + my ($tb1, $te1, $tlb1, $tle1, $tb2, $te2, $tlb2, $tle2) = + ($b1, $e1, $lb1, $le1, $b2, $e2, $lb2, $le2); + ($b1, $e1, $lb1, $le1, $b2, $e2, $lb2, $le2) = + @diff_str[$idx*8..($idx+1)*8-1]; + $lb1 = $INFINITY if ($lb1 < 0); + $lb2 = $INFINITY if ($lb2 < 0); + $le1 = $INFINITY if ($le1 < 0); + $le2 = $INFINITY if ($le2 < 0); + if ($te1 > $b1) { + ($b1, $lb1) = ($te1, $tle1); + } + if ($te2 > $b2) { + ($b2, $lb2) = ($te2, $tle2); + } + + last if ($lb1 != $j); + + my $begin_char = $l_culx - $b1; + + $line =~ /^(.*)(.{$begin_char})$/; + $html_line .= spacedHtmlText($1) . + ''; + $line = $2; + } + push(@left_html, + sprintf('%s%s', + $html_line, spacedHtmlText($line))); + } else { + $line = spacedHtmlText($line); + push(@left_html, "$line"); + } + } + ($idx, $b1, $e1, $lb1, $le1, $b2, $e2, $lb2, $le2) = + (0, @diff_str[0..7]); + $lb1 = $INFINITY if ($lb1 < 0); + $lb2 = $INFINITY if ($lb2 < 0); + $le1 = $INFINITY if ($le1 < 0); + $le2 = $INFINITY if ($le2 < 0); + for (my $j = 0; $j < $rightRow; $j++) { + my $line_len = length(@$rightColRef[$j]); + my $line = @$rightColRef[$j]; + $r_cul += length($line) + 1; # includes "\n" + my $r_culx = $r_cul - 1; # not includes "\n" + if ($j < $lb2) { + $line = spacedHtmlText($line); + push(@right_html, "$line"); + } elsif ($lb2 == $j) { + my $html_line; + while ($lb2 == $j) { + my $begin_char = $r_culx - $b2; + + $line =~ /^(.*)(.{$begin_char})$/; + $html_line .= spacedHtmlText($1) . + ''; + $line = $2; + + last if ($j != $le2); + + my $end_char = $r_culx - $e2; + $line =~ /^(.*)(.{$end_char})$/; + $html_line .= spacedHtmlText($1) . + ''; + $line = $2; + + $idx++; + my ($tb1, $te1, $tlb1, $tle1, $tb2, $te2, $tlb2, $tle2) = + ($b1, $e1, $lb1, $le1, $b2, $e2, $lb2, $le2); + ($b1, $e1, $lb1, $le1, $b2, $e2, $lb2, $le2) = + @diff_str[$idx*8..($idx+1)*8-1]; + $lb1 = $INFINITY if ($lb1 < 0); + $lb2 = $INFINITY if ($lb2 < 0); + $le1 = $INFINITY if ($le1 < 0); + $le2 = $INFINITY if ($le2 < 0); + if ($te1 > $b1) { + ($b1, $lb1) = ($te1, $tle1); + } + if ($te2 > $b2) { + ($b2, $lb2) = ($te2, $tle2); + } + } + push(@right_html, + sprintf('%s%s', + $html_line, spacedHtmlText($line))); + } elsif ($le2 == $j) { + my $html_line; + while ($le2 == $j) { + my $end_char = $r_culx - $e2; + $line =~ /^(.*)(.{$end_char})$/; + $html_line .= spacedHtmlText($1) . + ''; + $line = $2; + + $idx++; + my ($tb1, $te1, $tlb1, $tle1, $tb2, $te2, $tlb2, $tle2) = + ($b1, $e1, $lb1, $le1, $b2, $e2, $lb2, $le2); + ($b1, $e1, $lb1, $le1, $b2, $e2, $lb2, $le2) = + @diff_str[$idx*8..($idx+1)*8-1]; + $lb1 = $INFINITY if ($lb1 < 0); + $lb2 = $INFINITY if ($lb2 < 0); + $le1 = $INFINITY if ($le1 < 0); + $le2 = $INFINITY if ($le2 < 0); + if ($te1 > $b1) { + ($b1, $lb1) = ($te1, $tle1); + } + if ($te2 > $b2) { + ($b2, $lb2) = ($te2, $tle2); + } + + last if ($lb2 != $j); + + my $begin_char = $r_culx - $b2; + $line =~ /^(.*)(.{$begin_char})$/; + $html_line .= spacedHtmlText($1) . + ''; + $line = $2; + } + push(@right_html, + sprintf('%s%s', + $html_line, spacedHtmlText($line))); + } else { + $line = spacedHtmlText ($line); + push @right_html, "$line"; + } + } + for (my $j = 0; $j < $leftRow || $j < $rightRow ; $j++) { # dump out both cols + print ''; + if ($j < $leftRow) { + print $left_html[$j]; + } else { + print ' '; + } + if ($j < $rightRow) { + print $right_html[$j]; + } else { + print ' '; + } + print "\n"; + } + } else { + for (my $j = 0; $j < $leftRow || $j < $rightRow; $j++) { # dump both cols + print "\n"; + if ($j < $leftRow) { + print ' ' . + spacedHtmlText(@$leftColRef[$j]) . ''; + } else { + print ' '; + } + print "\n"; + + if ($j < $rightRow) { + print ' ' . + spacedHtmlText(@$rightColRef[$j]) . ''; + } else { + print ' '; + } + print "\n\n"; + } + } + } +} + + +# +# Generates "human readable", HTMLified diffs. +# +sub human_readable_diff($$) +{ + my ($fh, $rev) = @_; + + (my $where_nd = $where) =~ s|\.diff$||; + (my $filename = $where_nd) =~ s|^.*/||; + (my $pathname = $where_nd) =~ s|((?<=/)Attic/)?[^/]*$||; + (my $scriptwhere_nd = $scriptwhere) =~ s|\.diff$||; + + navigateHeader($scriptwhere_nd, $pathname, $filename, $rev, 'diff'); + + # Read header to pick up read revision and date, if possible. + + my ($r1d, $r1r, $r2d, $r2r); + while (<$fh>) { + ($r1d, $r1r) = /\t(.*)\t(.*)$/ if (/^--- /); + ($r2d, $r2r) = /\t(.*)\t(.*)$/ if (/^\+\+\+ /); + last if (/^\+\+\+ /); + } + + my ($rev1, $date1); + if (defined($r1r) && $r1r =~ /^(\d+\.)+\d+$/) { + $rev1 = $r1r; + $date1 = $r1d; + } + my ($rev2, $date2); + if (defined($r2r) && $r2r =~ /^(\d+\.)+\d+$/) { + $rev2 = $r2r; + $date2 = $r2d; + } + $rev1 = $input{r1} unless defined($rev1); + $rev1 = $input{tr1} if (defined($rev1) && $rev1 eq 'text'); + $rev1 = 'unknown-left' unless defined($rev1); + $rev2 = $input{r2} unless defined($rev2); + $rev2 = $input{tr2} if (defined($rev2) && $rev2 eq 'text'); + $rev2 = 'unknown-right' unless defined($rev2); + $date1 = defined($date1) ? ', ' . htmlquote($date1) : ''; + $date2 = defined($date2) ? ', ' . htmlquote($date2) : ''; + + my $link = uri_escape($filename) . ($query ? "$query;" : '?'); + + # Using Diff for /$where_nd between versions $rev1 and $rev2 +
+ + + + +EOF + + # Process diff text + # prefetch several lines + my @buf = head($fh); + my %d = scan_directives(@buf); + + my $leftRow = 0; + my $rightRow = 0; + my ($difftxt, @rightCol, @leftCol, $oldline, $newline, $funname); + + $link .= 'content-type=text%2Fx-cvsweb-markup;'; + $link .= 'ln=1;' unless ($link =~ /\?.*\bln=1\b/); + + while (@buf || !eof($fh)) { + $difftxt = @buf ? shift @buf : <$fh>; + + if ($difftxt =~ /^@@/) { + ($oldline, $newline, $funname) = + $difftxt =~ /@@ \-([0-9]+).*\+([0-9]+).*@@(.*)/; + $funname = htmlquote($funname); + $funname =~ s/\s/ /go; + $funname &&= " $funname"; + my $ol = $oldline || 1; + my $nl = $newline || 1; + + print < + + + +EOF + + $state = "dump"; + $leftRow = 0; + $rightRow = 0; + } else { + my ($diffcode, $rest) = $difftxt =~ /^([-+ ])(.*)/; + $diffcode = '' unless defined($diffcode); + $_ = $rest; + + ######### + # little state machine to parse unified-diff output (Hen, zeller@think.de) + # in order to get some nice 'ediff'-mode output + # states: + # "dump" - just dump the value + # "PreChangeRemove" - we began with '-' .. so this could be the start of a 'change' area or just remove + # "PreChange" - okey, we got several '-' lines and moved to '+' lines -> this is a change block + ########## + + if ($diffcode eq '+') { + if ($state eq "dump") + { # 'change' never begins with '+': just dump out value + $_ = spacedHtmlText($rest, $d{tabstop}); + printf(< + + + +EOF + } else { # we got minus before + $state = "PreChange"; + $rightCol[$rightRow++] = $_; + } + } elsif ($diffcode eq '-') { + $state = "PreChangeRemove"; + $leftCol[$leftRow++] = $_; + } else { # empty diffcode + flush_diff_rows \@leftCol, \@rightCol, $leftRow, $rightRow; + $_ = spacedHtmlText($rest, $d{tabstop}); + printf(< + + + +EOF + $state = "dump"; + $leftRow = 0; + $rightRow = 0; + } + } + } + close($fh); + + flush_diff_rows \@leftCol, \@rightCol, $leftRow, $rightRow; + + # state is empty if we didn't have any change + if (!$state) { + print < + + + + + +EOF + } + + printf(< +
+
+
+
+
+version $rev1$date1 + +version $rev2$date2 +
+ Line $oldline$funname + + Line $newline$funname +
  %s
 %s %s
 
- No viewable change -
+ + + + + + + + + +
Removed from v.%s 
changed lines
 Added in v.%s
+ +
+EOF +} + + +sub doEnscript($$$;$) +{ + my ($filehandle, $highlight, $linenumbers, $lang) = @_; + $lang ||= 'cvsweb'; + + my @cmd = ($CMD{enscript}, + @enscript_options, + '-q', "--language=$lang", '-o', '-', "--highlight=$highlight"); + + local *ENSCRIPT_OUT; + my ($h, $err) = + startproc(\@cmd, $filehandle, '>pipe', \*ENSCRIPT_OUT); + fatal('500 Internal Error', $err) unless $h; + + # We could short-circuit and have enscript output directly to STDOUT above, + # but that doesn't work with mod_perl (at least some 1.99 versions). + if ($linenumbers) { + my $ln = 0; + while () { + printf '%5d: ', (++$ln) x 2; + print $_; + } + } else { + local $/ = undef; + print ; + } + $h->finish(); +} + + +# +# The passed in $path and $filename should not be URI escaped, and $swhere +# *should* be. +# +sub navigateHeader($$$$$;$) +{ + my ($swhere, $path, $filename, $rev, $title, $moddate) = @_; + $swhere = "" if ($swhere eq $scriptwhere); + $swhere = './' . uri_escape($filename) if ($swhere eq ""); + + my $qfile = htmlquote($filename); + my $qpath = htmlquote($path); + my $trev = $rev ? " - " . htmlquote($rev) : ''; + + http_header('text/html', $moddate); + + (my $header = &cgi_style::html_header($title, 0)) =~ s,\A.*,\n$HTML_META,s; + $header .= $CSS . +' + + + "; + + printf(<%s Up to %s + + +EOF +} + + +sub plural_write($$) +{ + my ($num, $text) = @_; + if ($num != 1) { + $text .= "s"; + } + + if ($num > 0) { + return join (' ', $num, $text); + } else { + return ""; + } +} + + ## # print readable timestamp in terms of # '..time ago' # H. Zeller ## -sub readableTime($$) { - my ($i, $break, $retval); - my ($secs, $long) = @_; +sub readableTime($$) +{ + my ($secs, $long) = @_; - # this function works correct for time >= 2 seconds - if ($secs < 2) { - return "very little time"; - } + # 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; - $i = 0; + my %desc = ( + 1 => 'second', + 60 => 'minute', + 3600 => 'hour', + 86400 => 'day', + 604800 => 'week', + 2628000 => 'month', + 31536000 => 'year' + ); - while ($i <= $#breaks && $secs >= 2 * $breaks[$i]) { - $i++; - } - $i--; - $break = $breaks[$i]; - $retval = plural_write(int($secs / $break), $desc{$break}); + my @breaks = sort { $a <=> $b } keys %desc; + my $i = 0; - 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"; - } - } + while ($i <= $#breaks && $secs >= 2 * $breaks[$i]) { + $i++; + } + $i--; + my $break = $breaks[$i]; + my $retval = plural_write(int($secs / $break), $desc{$break}); - return $retval; + 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; } -## -# clickablePath(String pathname, boolean last_item_clickable) + # -# returns a html-ified path whereas each directory is a link for -# faster navigation. last_item_clickable controls whether the -# basename (last directory/file) is a link as well -## -sub clickablePath($$) { - my ($pathname, $clickLast) = @_; - my $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) = @_; - if ($pathname eq '/') { + my $root = '[' . htmlquote($CVSROOTdescr{$cvstree} || $cvstree) . ']'; - # this should never happen - chooseCVSRoot() is - # intended to do this - $retval = "[$cvstree]"; - } else { - $retval .= ' ' . &link("[$cvstree]", - sprintf('%s/%s#dirlist', $scriptname, $query)); - my $wherepath = ''; - my ($lastslash) = $pathname =~ m|/$|; + # This should never happen (see chooseCVSRoot()), but let's be sure... + return $root if ($pathname eq '/'); - foreach (split (/\//, $pathname)) { - $retval .= " / "; - $wherepath .= "/$_"; - my ($last) = "$wherepath/" eq "/$pathname" - || $wherepath eq "/$pathname"; + my $retval = + ' ' . &link($root, sprintf('%s/%s#dirlist', $scriptname, $query)); + my $wherepath = ''; + my ($lastslash) = $pathname =~ m|/$|; - if ($clickLast || !$last) { - $retval .= &link($_, - join ('', $scriptname, - urlencode($wherepath), - (!$last || $lastslash ? '/' : ''), - $query, - (!$last || $lastslash ? "#dirlist" : "") - )); - } else { # do not make a link to the current dir - $retval .= $_; - } - } - } - return $retval; + 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 "
\n"; - if (2 <= @CVSROOT) { - my ($k); - foreach $k (keys %input) { - print "\n" - if ($input{$k}) && ($k ne "cvsroot"); - } +sub chooseCVSRoot() +{ + print "\n

\n"; + if (2 <= @CVSROOT) { + foreach my $k (keys %input) { + printf("\n", + htmlquote($k), htmlquote($input{$k})) + if ($input{$k} && $k ne 'cvsroot'); + } - # Form-Elements look wierd in Netscape if the background - # isn't gray and the form elements are not placed - # within a table ... - print "\n\n"; - print "\n"; - print "\n\n\n
\n +EOF - foreach $k (@CVSROOT) { - print "\n"; - } - print "\n"; - } else { + foreach my $k (@CVSROOT) { + printf("\n", + htmlquote($k), + ($k eq $cvstree) ? ' selected="selected"' : '', + htmlquote($CVSROOTdescr{$k} || $k)); + } + print ''; + } else { - # no choice -- but we need the form to select module/path, - # at least for Netscape - print "

\n"; - print "CVS Root: [$cvstree]"; - } + # no choice -- but we need the form to select module/path, + # at least for Netscape + printf "CVS Root: [%s]", + htmlquote($CVSROOTdescr{$cvstree} || $cvstree); + } - print " \n"; - print "\n"; - print ""; - - if (2 <= @CVSROOT) { - print "

"; - } else { - print "

"; - } - print "\n
"; + print < +Module path or alias: + + + +

+ +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; +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"; + # 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); + my @tmp = map(&link(htmlquote($_), $MIRRORS{$_}), sort keys %MIRRORS); + my $tmp = pop (@tmp); - if (scalar(@tmp)) { - print join(', ', @tmp), ' and '; - } + if (scalar(@tmp)) { + print join (', ', @tmp), ' and '; + } - print "$tmp.\n

\n"; + print "$tmp.\n

\n"; } -sub fileSortCmp() { - my ($comp) = 0; - my ($c, $d, $af, $bf); - ($af = $a) =~ s/,v$//; - ($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})); +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})); - if (defined($filename1) && defined($filename2) && $af eq $filename1 - && $bf eq $filename2) - { + 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); - $comp = ($log1 cmp $log2) if ($bylog && $log1 && $log2); - $comp = ($author1 cmp $author2) - if ($byauthor && $author1 && $author2); - } + # 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) { + if ($comp == 0) { - # Directories first, then files under version control, - # then other, "rogue" files. - # Sort by filename if no other criteria available. + # 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')); - ($c = $a) =~ s|.*/||; - ($d = $b) =~ s|.*/||; - $comp = ("$ad$c" cmp "$bd$d"); - } - return $comp; + 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; } -# make A url for downloading -sub download_url($$;$) { - my ($url, $revision, $mimetype) = @_; +# +# 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); - $revision =~ s/\b0\.//; + 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; - if (defined($checkoutMagic) - && (!defined($mimetype) || $mimetype ne "text/x-cvsweb-markup")) - { - my $path = $where; - $path =~ s|[^/]+$||; - $url = "$scriptname/$checkoutMagic/${path}$url"; - } - $url .= "?rev=$revision"; - $url .= '&content-type=' . urlencode($mimetype) if (defined($mimetype)); - - $url; + return $url; } -# Presents a link to download the -# selected revision -sub download_link($$$;$) { - my ($url, $revision, $textlink, $mimetype) = @_; - my ($fullurl) = download_url($url, $revision, $mimetype); +# +# 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)); +} - $fullurl =~ s/:/sprintf("%%%02x", ord($&))/eg; +# +# 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; +} - printf '%s', + display_url($url, $revision, $mtype) . $barequery, + htmlquote($textlink)); +} - if ($open_extern_window - && (!defined($mimetype) || $mimetype ne "text/x-cvsweb-markup")) - { - print ' target="cvs_checkout"'; +# +# 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); +} - # we should have - # 'if (document.cvswin==null) document.cvswin=window.open(...' - # in order to allow the user to resize the window; otherwise - # the user may resize the window, but on next checkout - zap - - # its original (configured s. cvsweb.conf) size is back again - # .. annoying (if $extern_window_(width|height) is defined) - # but this if (..) solution is far from perfect - # what we need to do as well is - # 1) save cvswin in an invisible frame that always exists - # (document.cvswin will be void on next load) - # 2) on close of the cvs_checkout - window set the cvswin - # variable to 'null' again - so that it will be - # reopenend with the configured size - # anyone a JavaScript programmer ? - # .. so here without if (..): - # currently, the best way is to comment out the size parameters - # ($extern_window...) in cvsweb.conf. - if ($use_java_script) { - my @attr = qw(resizable scrollbars); - - push @attr, qw(status toolbar) - if (defined($mimetype) && $mimetype eq "text/html"); - - push @attr, "width=$extern_window_width" - if (defined($extern_window_width)); - - push @attr, "height=$extern_window_height" - if (defined($extern_window_height)); - - # We need the "return false" here to prevent browsers - # from following the href after the onclick handler. - # This would effectively load the same document in - # the same window *twice*. - printf - q` onclick="window.open('%s','cvs_checkout','%s');return false"`, - hrefquote("$fullurl$barequery"), join (',', @attr); - } - } - print ">$textlink"; +# +# 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 ($newquery, $var); - my (%vars); - %vars = %input; +sub toggleQuery($;$) +{ + my ($toggle, $value) = @_; - if (defined($value)) { - $vars{$toggle} = $value; - } else { - $vars{$toggle} = $vars{$toggle} ? 0 : 1; - } + my %vars = %input; - # Build a new query of non-default paramenters - $newquery = ""; - foreach $var (@stickyvars) { - my ($value) = defined($vars{$var}) ? $vars{$var} : ""; - my ($default) = - defined($DEFAULTVALUE{$var}) ? $DEFAULTVALUE{$var} : ""; + if (defined($value)) { + $vars{$toggle} = $value; + } else { + $vars{$toggle} = $vars{$toggle} ? 0 : 1; + } - if ($value ne $default) { - $newquery .= "&" if ($newquery ne ""); - $newquery .= urlencode($var) . "=" . urlencode($value); - } - } + # 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 ($newquery) { - return '?' . $newquery; - } - return ""; + if ($value ne $default) { + $newquery .= ';' if ($newquery ne ""); + $newquery .= uri_escape($var) . '=' . uri_escape($value); + } + } + + if ($newquery) { + return '?' . $newquery; + } + return ""; } -sub urlencode($) { - local ($_) = @_; - - s/[\000-+{-\377]/sprintf("%%%02x", ord($&))/ge; - - $_; +sub htmlquote($) +{ + local ($_) = @_; + # Special Characters; RFC 1866 + s/&/&/g; + s/\"/"/g; + s//>/g; + return $_; } -sub htmlquote($) { - local ($_) = @_; - - # Special Characters; RFC 1866 - s/&/&/g; - s/\"/"/g; - s//>/g; - - $_; +sub htmlunquote($) +{ + 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; - - $_; +sub uri_escape_path($) +{ + return join('/', map(uri_escape($_), split(m|/+|, shift, -1))); } -sub hrefquote($) { - local ($_) = @_; +sub http_header(;$$) +{ + my ($content_type, $moddate) = @_; + $content_type ||= 'text/html'; - y/ /+/; + $content_type .= "; charset=$charset" + if ($charset && $content_type =~ m,^text/,); - htmlquote($_) + # 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 http_header(;$) { - my $content_type = shift || "text/html"; - $content_type .= "; charset=$charset" - if $content_type =~ m,^text/, && defined($charset) && $charset; +sub html_header($;$) +{ + my ($title, $moddate) = @_; + $title = htmlquote($title); + my $css = $CSS || ''; + http_header('text/html', $moddate); - if (defined($moddate)) { - if ($is_mod_perl) { - Apache->request->header_out( - "Last-Modified" => scalar gmtime($moddate) - . " GMT"); - } else { - print "Last-Modified: ", scalar gmtime($moddate), - " GMT\r\n"; - } - } - - if ($is_mod_perl) { - Apache->request->content_type($content_type); - } else { - print "Content-Type: $content_type\r\n"; - } - - if ($allow_compress && $maycompress) { - if ($has_zlib - || (defined($CMD{gzip}) && open(GZIP, "| $CMD{gzip} -1 -c")) - ) - { - - if ($is_mod_perl) { - Apache->request->content_encoding("x-gzip"); - Apache->request->header_out( - Vary => "Accept-Encoding"); - Apache->request->send_http_header; - } else { - print "Content-Encoding: x-gzip\r\n"; - print "Vary: Accept-Encoding\r\n" - ; #RFC 2068, 14.43 - print "\r\n"; # Close headers - } - $| = 1; - $| = 0; # Flush header output - - if ($has_zlib) { - tie *GZIP, __PACKAGE__, \*STDOUT; - } - select(GZIP); - $gzip_open = 1; - - # print "" if ($content_type =~ m|^text/html\b|); - } else { - if ($is_mod_perl) { - Apache->request->send_http_header; - } else { - print "\r\n"; # Close headers - } - print - "Unable to find gzip binary in the \$command_path ($command_path) to compress output
"; - } - } else { - - if ($is_mod_perl) { - Apache->request->send_http_header; - } else { - print "\r\n"; # Close headers - } - } + (my $header = &cgi_style::html_header($title, 0)) =~ s,\A.*,\n$HTML_META,s; + $header .= $css; + print $header; } -sub html_header($) { - my ($title) = @_; - http_header("text/html"); - - (my $header = &cgi_style::html_header($title, 0)) =~ s,\A.*,\n$HTML_META,s; - print $header; +sub html_footer() +{ + print &cgi_style::html_footer; } -sub html_footer() { - print &cgi_style::html_footer; +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; } -sub link_tags($) { - my ($tags) = @_; - my ($ret) = ""; - my ($fileurl, $filename); - ($filename = $where) =~ s/^.*\///; - $fileurl = './' . urlencode($filename); +# +# 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; +} - foreach my $sym (split (", ", $tags)) { - $ret .= ",\n" if ($ret ne ""); - $ret .= - &link($sym, $fileurl . toggleQuery('only_with_tag', $sym)); - } - return "$ret\n"; + +# +# 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); } # -# See if a module is listed in the config file's @HideModules list. +# Runs a process using IPC::Run. All arguments are passed to +# IPC::Run::run() as-is. Returns an array ($exitcode, $errormsg). # -sub forbidden_module($) { - my ($module) = @_; - local $_; - - for (@HideModules) { - return 1 if $module =~ $_; - } - return 0; +sub runproc(@) +{ + eval { + local $SIG{__DIE__}; + IPC::Run::run(@_); + }; + my $exitcode = $? >> 8; + my $errormsg = undef; + if ($@) { + $exitcode ||= -1; + $errormsg = "'@{$_[0]}' failed: $@"; + } + return ($exitcode, $errormsg); } -sub forbidden_file($) { - my ($path) = @_; - $path = substr($path, length($cvsroot) + 1); - local $_; - for (@ForbiddenFiles) { - return 1 if $path =~ $_; - } - return 0; +# +# 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 remove the tie. - -sub gzipclose { - if ($gzip_open) { - select(STDOUT); - close(GZIP); - untie *GZIP; - $gzip_open = 0; - } +# +# 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 @@ -3703,67 +4446,78 @@ 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 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 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 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 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 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); +sub DESTROY +{ + my ($o) = @_; + CLOSE($o); } + +# Local variables: +# indent-tabs-mode: nil +# cperl-indent-level: 2 +# End: diff --git a/en/cgi/cvsweb.conf b/en/cgi/cvsweb.conf index 47a47f2d34..eb5b2ca130 100644 --- a/en/cgi/cvsweb.conf +++ b/en/cgi/cvsweb.conf @@ -1,47 +1,61 @@ -# -*-perl-*- -# Configuration of cvsweb.cgi, the -# CGI interface to CVS Repositories. +# -*- perl -*- +# Configuration of cvsweb.cgi, a web interface to CVS repositories. # # (c) 1998-1999 H. Zeller # 1999 H. Nordstrom # 2000-2002 A. MUSHA -# 2002 V. Skyttä +# 2002-2005 V. Skyttä # based on work by Bill Fenner # -# $Id: cvsweb.conf,v 1.38 2006-01-19 19:53:38 ceri Exp $ +# $FreeBSD: projects/cvsweb/cvsweb.conf,v 1.97 2005/06/19 09:13:50 scop Exp $ +# $Id: cvsweb.conf,v 1.39 2007-03-17 22:28:31 simon Exp $ # $Idaemons: /home/cvs/cvsweb/cvsweb.conf,v 1.27 2001/08/01 09:48:39 knu Exp $ -# $FreeBSD: www/en/cgi/cvsweb.conf,v 1.37 2004/04/04 21:49:38 phantom Exp $ # -### + +# +# Unless otherwise noted, all boolean parameters here default to off +# when no value for them has been explicitly set. +# # Set the path for the following commands: -# uname, cvs, rlog, rcsdiff +# cvs, rlog, rcsdiff # gzip (if you enable $allow_compress) -# tar, rm, zip (if you enable $allow_tar) -$command_path = '/bin:/usr/bin:/usr/local/bin'; +# (g)tar, zip (if you enable $allow_tar) +# cvsgraph (if you enable $allow_graph) +# enscript (if you enable $allow_enscript) +# +@command_path = qw(/bin /usr/bin /usr/local/bin); -# Search the above directories for each command -for (qw(uname cvs rlog rcsdiff gzip tar rm zip)) { +# Search the above directories for each command (prefer gtar over tar). +# +for (qw(cvs rlog rcsdiff gzip gtar zip cvsgraph enscript)) { $CMD{$_} = search_path($_); } +$CMD{tar} = delete($CMD{gtar}) if $CMD{gtar}; +$CMD{tar} ||= search_path('tar'); -# The name of the operating system implementation -chomp($uname = `$CMD{uname}`); - -############## -# CVS Root -############## -# CVSweb can handle several CVS-Repositories -# at once. Enter a short symbolic names and the -# full path of these repositories here. -# NOTE that the symbolic names may not contain -# whitespaces. -# Note, that cvsweb.cgi currently needs to have physical access -# to the CVS repository so :pserver:someone@xyz.com:/data/cvsroot -# won't work! - -# 'symbolic_name' => ['name_to_display', 'path_to_the_actual_repository'] -# Listed in the order specified: +# CVS roots +# +# CVSweb can handle several CVS repositories at once. Enter short (internal) +# symbolic repository names, their names in the UI and the actual locations +# here. The repositories will be listed in the order they're specified here. +# +# Obviously, CVSweb will need read access to these repository dirs. If you +# receive an error that no valid CVS roots were found, double-check the file +# permissions and any other attributes your system may have for the repository +# directories, such as SELinux file contexts. +# +# CVSweb will also load per-cvsroot configuration files if they exist. +# The symbolic_name (see below) of the CVS root will be concatenated into the +# name of the main (this) configuration file along with a hyphen, and that +# file will be loaded for that particular CVS root. For examples, see +# cvsweb.conf-* in the CVSweb distribution. +# +# Note that only local repositories are currently supported. Things like +# :pserver:someone@xyz.com:/data/cvsroot won't work. +# +# 'symbolic_name' => ['Name to display', '/path/to/cvsroot'] +# @CVSrepositories = ( 'freebsd' => ['FreeBSD', '/usr/local/www/cvsroot/FreeBSD'], 'openbsd' => ['OpenBSD', '/usr/local/www/cvsroot/OpenBSD'], @@ -50,13 +64,19 @@ chomp($uname = `$CMD{uname}`); 'learn' => ['Learn', '/c/learncvs'], ); -# This tree is enabled by default when -# you enter the page -$cvstreedefault = $CVSrepositories[2 * 0]; # The first one +# The default CVS root. Note that @CVSrepositories is list, not a hash, +# so you'll want to use 2 * 0-based-index-number here; or set this directly +# to the default's symbolic name. Unless specified, the first valid one in +# @CVSrepositories is used as the default. +# +# For example: +# +#$cvstreedefault = $CVSrepositories[2 * 0]; +#$cvstreedefault = 'local'; -############## -# Mirror Sites -############## +# Mirror sites. The keys will be used as link texts, and the values are +# URLs pointing to the corresponding mirrors. +# %MIRRORS = ( 'Germany' => 'http://cvsup-netbsd.leo.org/cgi-bin/cvsweb.cgi/?cvsroot=freebsd', 'Japan' => 'http://www.jp.FreeBSD.org/cgi/cvsweb.cgi', @@ -66,12 +86,11 @@ $cvstreedefault = $CVSrepositories[2 * 0]; # The first one 'Turkey' => 'http://cvsweb.tr.FreeBSD.org/', 'Ukraine' => 'http://www.FreeBSD.org.ua/cgi/cvsweb.cgi?cvsroot=freebsd', 'USA/California' => 'http://cvsweb.FreeBSD.org/', - ); +); -############## -# Bug tracking system options -# ("PR" means Problem Report, as in GNATS) -############## +# Bug tracking system linking options ("PR" means Problem Report, as in GNATS) +# This will be done only for views for which $allow_*_extra below is true. +# #@prcategories = qw( # advocacy # alpha @@ -86,112 +105,112 @@ $cvstreedefault = $CVSrepositories[2 * 0]; # The first one # ports # sparc #); - -# #$prcgi = "http://www.FreeBSD.org/cgi/query-pr.cgi?pr=%s"; -# #$prkeyword = "PR"; -############## -# Manual gateway -############## +# Manual gateway linking. This will be done only for views for which +# $allow_*_extra below is true. +# $mancgi = "http://www.FreeBSD.org/cgi/man.cgi?apropos=0&sektion=%s&query=%s&manpath=FreeBSD+7.0-current&format=html"; -############## -# Defaults for UserSettings -############## +# Defaults for user definable options. +# %DEFAULTVALUE = ( - # sortby: File sort order - # file Sort by filename - # rev Sort by revision number - # date Sort by commit date - # author Sort by author - # log Sort by log message + # sortby: File sort order + # file Sort by filename + # rev Sort by revision number + # date Sort by commit date + # author Sort by author + # log Sort by log message + "sortby" => "file", - "sortby" => "file", + # ignorecase: Ignore case in sorts (filenames, authors, log messages) + # 0 Honor case + # 1 Ignore case + "ignorecase" => "0", - # hideattic: Hide or show files in Attic - # 1 Hide files in Attic - # 0 Show files in Attic + # hideattic: Hide or show files in Attic + # 1 Hide files in Attic + # 0 Show files in Attic + "hideattic" => "1", - "hideattic" => "1", + # logsort: Sort order for CVS logs + # date Sort revisions by date + # rev Sort revision by revision number + # cvs Don't sort them. Same order as CVS/RCS shows them. + "logsort" => "date", - # logsort: Sort order for CVS logs - # date Sort revisions by date - # rev Sort revision by revision number - # cvs Don't sort them. Same order as CVS/RCS shows them. + # f: Default diff format + # h Human readable + # u Unified diff + # c Context diff + # s Side by side + # uc Unified diff, enscript colored (falls back to "u" w/o enscript) + # cc Context diff, enscript colored (falls back to "c" w/o enscript) + # sc Side by side, enscript colored (falls back to "s" w/o enscript) + "f" => "u", - "logsort" => "date", + # hidecvsroot: Don't show the CVSROOT directory. Note that this is + # just the default for a user settable option (like others in this + # %DEFAULTVALUE hash); it won't really prevent access to CVSROOT. + # See @ForbiddenFiles for that. + # 1 Do not include the top-level CVSROOT directory in dir listings + # 0 Treat the top-level CVSROOT directory just like all other dirs + "hidecvsroot" => "0", - # f: Default diff format - # h Human readable - # u Unified diff - # c Context diff - # s Side by side - "f" => "u", + # hidenonreadable: Don't show files and directories that cannot be read + # in directory listings. + # 1 Hide non-readable entries + # 0 Show non-readable entries + "hidenonreadable" => "1", - # hidecvsroot: Don't show the CVSROOT directory - # 1 Hide CVSROOT directory - # 0 Show CVSROOT directory - "hidecvsroot" => "0", - - # hidenonreadable: Don't show entries which cannot be read - # 1 Hide non-readable entries - # 0 Show non-readable entries - "hidenonreadable" => "1", + # ln: Show line numbers in HTMLized views + # 1 Show line numbers + # 0 Don't show line numbers + "ln" => "0", ); -############## -# some layout stuff -############## - -# The body-tag for directory views and logs -$body_tag = ''; - -# The body-tag for diffs and annotations -$body_tag_for_src = ''; +# +# Layout options (see also the included CSS file) +# # Wanna have a logo on the page ? -$logo = ''; +# +#$logo = '

Powered by Apache

'; -# The title of the Page on startup. This will be put inside a

tag. +# The title of the Page on startup. This will be put inside

and +# tags, and HTML escaped. +# $defaulttitle = "CVS Repository"; # The address is shown on the footer. This will be put inside a <address> tag. +# $address = '<span style="font-size: smaller">FreeBSD-CVSweb <<a href="mailto:freebsd-cvsweb@FreeBSD.org">freebsd-cvsweb@FreeBSD.org</a>></span>'; -# color of navigation Header for -# diffs and annotations -$navigationHeaderColor = '#9999ee'; - $long_intro = <<EOT; <p> -This is a WWW interface to the !!CVSROOTdescr!! CVS tree. -You can browse the file hierarchy by picking directories -(which have slashes after them, <i>e.g.</i>, <b>src/</b>). -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 +This is a WWW interface for the !!CVSROOTdescr!! CVS repository. +You can browse the file hierarchy by following directory links (which +have slashes after them, e.g. <code>src/</code>). +If you follow a link to a file, you will see its revision history. +Following a link labeled with a revision number will display that +revision of the file. In the revision history view, there is a link +near 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. -</p> -<p> +</p><p> This script has been written by Bill Fenner and improved by Henner Zeller, Henrik Nordström, and Ken Coar, then Akinori MUSHA brought it back to FreeBSD community and made further improvements; it is covered by <a -href="http://www.opensource.org/licenses/bsd-license.html">The BSD Licence</a>. -</p> -<p> +href="http://www.opensource.org/licenses/bsd-license.html">The BSD License</a>. +</p><p> If you would like to use this CGI script on your own web server and -CVS tree, download the latest version from <URL:<a +CVS tree, download the latest version from <<a href="http://www.FreeBSD.org/projects/cvsweb.html">http://www.FreeBSD.org/projects/cvsweb.html</a>>. -</p> -<p> +</p><p> Feel free to send any patches, suggestions and comments to the FreeBSD-CVSweb mailing list at <<a @@ -206,157 +225,141 @@ its revision history and to get a chance to display diffs between revisions. </p> EOT -# used icons; if icon-url is empty, the text representation is used; if -# you do not want to have an ugly tooltip for the icon, remove the -# text-representation. -# The width and height of the icon allow the browser to correcly display -# the table while still loading the icons. -# These default icons are coming with apache. -# If these icons are too large, check out the miniicons in the -# icons/ directory; they have a width/height of 16/16 -my $iconsdir = "/icons"; +# Icons for the web UI. If ICON-URL is empty, the TEXT representation is +# used. If you do not want to have a tool tip for an icon, set TEXT empty. +# The width and height of the icon allow the browser to correctly display +# the table while still loading the icons. If these icons are too large, +# check out the "mini" versions in the icons/ directory; they have a +# width/height of 16/16. +# +my $iconsdir = '/gifs'; -# format: TEXT ICON-URL width height +# format: TEXT ICON-URL width height %ICONS = ( - back => [("[BACK]", "$iconsdir/back.gif", 20, 22)], - dir => [("[DIR]", "$iconsdir/dir.gif", 20, 22)], - file => [("[TXT]", "$iconsdir/text.gif", 20, 22)], + back => [('[BACK]', "$iconsdir/back.gif", 20, 22)], + dir => [('[DIR]', "$iconsdir/dir.gif", 20, 22)], + file => [('[TXT]', "$iconsdir/text.gif", 20, 22)], + binfile => [('[BIN]', "$iconsdir/binary.gif", 20, 22)], + graph => [('[GRAPH]', "$iconsdir/minigraph.png", 16, 16)], ); undef $iconsdir; -# the length to which the last logentry should -# be truncated when shown in the directory view +# An URL where to find the CSS. +# +$cssurl = '/layout/css/cvsweb.css'; + +# The length to which the last log entry should be truncated when shown +# in the directory view. +# $shortLogLen = 80; -# Show author of last change +# Show author of last change? +# $show_author = 1; -############## -# table view for directories -############## - -# Show directory as table -# this is much more readable but has one -# drawback: the whole table has to be loaded -# before common browsers display it which may -# be annoying if you have a slow link - and a -# large directory .. -$dirtable = 1; - -# show different colors for even/odd rows -@tabcolors = ('#ffffff', '#ffffff'); +# Cell padding for directory table. +# $tablepadding = 2; -# Color of Header -$columnHeaderColorDefault = '#ffffcc'; -$columnHeaderColorSorted = '#ffcc66'; - -# -# If you want to have colored borders -# around each row, uncomment this -$tableBorderColor = '#cccccc'; - +# Regular expressions for files and directories which should be hidden. +# Each regexp is compared against a path relative to a CVS root, after +# stripping the trailing ",v" if present. Matching files and directories +# are not displayed. # -# Modules in the repository that should not be displayed, either by default -# nor by explicit path specification. -# -@HideModules = ( -# "^my/secret/module", -); - -# -# Files matching these pathnames shouldn't be checked out with cvsweb, -# since they may contain sensitive information. Simple file name based -# filter. Often, the CVSROOT/passwd is exposed and some people tend -# to check in their .cvspass, though this is a bad idea. These files -# shouldn't be readable by default. Thanks to Damian Gryski to point -# this out. -# Note that this affects only files, not directories. @ForbiddenFiles = ( - "^CVSROOT/passwd\$", # CVSROOT/passwd should not be cvs add'ed, though - "/\\.cvspass\$", # Ditto. Just in case. - "^CVSROOT/badcommitters\$", # Private project history. + qr|^CVSROOT/+passwd$|o, # CVSROOT/passwd should not be 'cvs add'ed though. + qr|/\.cvspass$|o, # Ditto. Just in case. + #qr|^my/+secret/+dir|o, ); -# -# Use CVSROOT/CVSROOT/descriptions for describing the directories/modules -# See INSTALL section 8 +# Use CVSROOT/descriptions for describing the directories/modules? +# See INSTALL, section 9. # $use_descriptions = 0; -############## -# Human Readable Diff -############## - +# +# Human readable diff. +# # (c) 1998 H. Zeller <zeller@think.de> # -# Generates two columns of color encoded -# diff; much like xdiff or emacs-ediff mode. +# Generates two columns of color encoded diff; much like xdiff or GNU Emacs' +# ediff-mode. # -# The diff-stuff is a piece of code I once made for -# cvs2html which is under GPL, -# see http://www.sslug.dk/cvs2html +# The diff-stuff is a piece of code I once made for cvs2html which is under +# GPL, see http://www.sslug.dk/cvs2html # (c) 1997/98 Peter Toft <pto@sslug.imm.dtu.dk> -# -# some parameters to screw: -## -# make lines breakable so that the columns do not -# exceed the width of the browser +# Make lines breakable so that the columns do not exceed the width of the +# browser? +# $hr_breakable = 1; -# give out function names in diffs -# this just makes sense if we have C-files, otherwise -# diff's heuristic doesn't work well .. -# ( '-p' option to diff) +# Print function names in diffs (unified and context only). +# See the -p option in the diff(1) man page. +# $showfunc = 1; # For each pair of regexps, files that match the first regexp will be diff'ed -# with an '-F' option with the second regexp. +# with an -F option using the second regexp (unified and context only). +# See the -F option in the diff(1) man page. +# %funcline_regexp = ( - "\\.(4th|fr)\$" => "\\(^\\|[ \t]\\): ", - "\\.rb\$" => "^[\t ]*\\(class\\|module\\|def\\) ", + qr/\.(?:4th|fr)$/o => "\\(^\\|[ \t]\\): ", + qr/\.rb$/o => "^[\t ]*\\(class\\|module\\|def\\) ", ); -# ignore whitespaces for human readable diffs -# (indendation and stuff ..) -# ( '-w' option to diff) +# Ignore whitespace in human readable diffs? ('-w' option to diff) +# $hr_ignwhite = 0; -# ignore diffs which are caused by -# keyword-substitution like $Id - Stuff -# ( '-kk' option to rcsdiff) +# Ignore diffs which are caused by keyword substitution, $Id and friends? +# ('-kk' option to rcsdiff) +# $hr_ignkeysubst = 1; -# Colors and font to show the diff type of code changes -$diffcolorHeading = '#99cccc'; # color of 'Line'-head of each diffed file -$diffcolorEmpty = '#cccccc'; # color of 'empty' lines -$diffcolorRemove = '#ff9999'; # Removed line(s) (left) ( - ) -$diffcolorChange = '#99ff99'; # Changed line(s) ( both ) -$diffcolorAdd = '#ccccff'; # Added line(s) ( - ) (right) -$diffcolorDarkChange = '#99cc99'; # lines, which are empty in change -$difffontface = "Helvetica,Arial"; -$difffontsize = "-1"; - -# the width of the textinput of the -# request-diff-form +# The width of the textinput of the "request diff" form. +# $inputTextSize = 12; -############## -# Mime Types -############## +# Custom per MIME type diff tools, used for comparing binary files such as +# spreadsheets, images etc. Each key is a MIME type in lowercase. +# Each value is an array ref of available diff tools for that type, each of +# which is a hash ref with values (mandatory where default not listed): +# name: the name to show in the UI for this diff type +# cmd: full path to executable +# args: arguments as an array ref (not string!, defaults to no arguments) +# type: output MIME type (defaults to text/plain) +# +%DIFF_COMMANDS = ( + #'text/xml' => [ + # { name => 'XMLdiff', + # cmd => $CMD{xmldiff}, + # }, + # { name => 'XMLdiff (XUpdate)', + # cmd => $CMD{xmldiff}, + # args => [ qw(-x) ], + # type => 'text/xml', + # }, + #], +); -# mapping to mimetypes to help -# cvsweb to guess the correct mime-type on -# checkout; you can use the mime.types from -# apache here: -$mime_types = '/usr/local/etc/apache/mime.types'; +# +# Mime types +# -# quick mime-type lookup; maps file-suffices to -# mime-types for displaying checkouts in the browser. -# Further MimeTypes will be found in the -# file $mime_types (apache style mime.types - file) -# - add common mappings here for faster lookup +# The MIME type lookup works like this: +# 1) Look up from %MTYPES below with the file name extension (suffix). +# 2) If not found, use the MIME::Types(3) module if it's available. +# 3) If not found, lookup from the $mime_types file (see below). +# 4) If not found, try %MTYPES{'*'}. +# 5) If not found, use 'application/octet-stream' if the file's keyword +# substitution mode is b (ie. the file was checked in as binary to CVS), +# 'text/plain' otherwise. + +# Quick MIME type lookup; maps filename extensions to MIME types. +# Add common mappings here for fast lookup. You can also use this +# to override MIME::Types(3) or the $mime_types file (see below). +# %MTYPES = ( "html" => "text/html", "shtml" => "text/html", @@ -365,10 +368,19 @@ $mime_types = '/usr/local/etc/apache/mime.types'; "jpg" => "image/jpeg", "png" => "image/png", "xpm" => "image/xpm", - "*" => "text/plain", +# "*" => "text/plain", ); -# Charset for HTML output +# The traditional mime.types file, eg. the one from Apache is fine. +# See above where this gets used. +# +$mime_types = '/usr/local/etc/apache/mime.types'; + +# Charset appended to the Content-Type HTTP header for text/* MIME types. +# Note that the web server may default to some charset which may take effect +# if you leave this parameter empty or unset. +# For Apache, see also the AddDefaultCharset directive. +# $charset = ''; # e.g. @@ -379,6 +391,7 @@ $charset = ''; # : 'iso-8859-1'; # Output filter +# $output_filter = ''; # e.g. @@ -388,144 +401,264 @@ $output_filter = ''; ############## # Misc ############## -# allow annotation of files -# this requires rw-access to the -# CVSROOT/history file (if you have one) -# and rw-access to the subdirectory to -# place the lock so you maybe don't want it + +# Allow annotation of files? See also @annotate_options below. +# $allow_annotate = 1; -# allow pretty-printed version of files +# Allow HTMLized versions of files? +# $allow_markup = 1; -# allow extra hlink formatting (such as PR xrefs) in logs -$allow_log_extra = 1; # default: enabled +# Allow CVSweb to create mailto: links from email addresses in various +# HTMLized views? Default: yes. +# +#$allow_mailtos = 0; -# allow extra hlink formatting (such as PR xrefs) in directories +## Extra hyperlinking means hyperlinks to bug tracking systems and manual page +## gateways, see $prcgi and $mancgi and related options above. + +# Allow extra hyperlinking (such as PR cross-references) in logs? +# Default: yes. +# +#$allow_log_extra = 0; + +# Allow extra hyperlinking in directory views? +# $allow_dir_extra = 1; -# allow extra hlink formatting in source code/formatted diff views +# Allow extra hyperlinking in source code/formatted diff views? +# $allow_source_extra = 1; -# allow compression with gzip -# of output if the Browser accepts -# it (HTTP_ACCEPT_ENCODING=gzip) -# [make sure to have gzip in the path] +# Allow compression with gzip in general? Note that this also requires +# that the browser supports it, and will be disabled on the fly when necessary. +# $allow_compress = 1; -# Make use of javascript functions. -# This way you can select one of your CVSroot -# without pressing 'Go' (.. if you do have more -# than one CVSROOT defined) +# Use JavaScript in the UI? +# $use_java_script = 1; -# open Download-Links in another window -$open_extern_window = 1; +# Show a form for setting options in the directory view? +# +$edit_option_form = 1; -# The size of this extern window; this size option -# needs use_java_script to be defined -# just comment them if you don't want to have a fixed -# size -#$extern_window_width = 600; -#$extern_window_height = 440; - -# Edit Options -# Enable form to edit your options (hideattic,sortbydate) -# this isn't necessary if you've $dirtable defined 'cause -# this allows editing of all your options more intuitive -$edit_option_form = (not $dirtable); - -# If you have files which automatically refers to other files -# (such as HTML) then this allows you to browse the checked -# out files as if outside CVS. -$checkout_magic = 1; - -# Show last changelog message for sub directories +# Show last changelog message for subdirectories? # The current implementation makes many assumptions and may show the # incorrect file at some times. The main assumption is that the last # modified file has the newest filedate. But some CVS operations -# touches the file without even when a new version is't checked in, -# and TAG based browsing essientially puts this out of order, unless -# the last checkin was on the same tag as you are viewing. +# touch the file even when a new version isn't checked in, and TAG +# based browsing essentially puts this out of order unless the last +# checkin was on the same tag as you are viewing. # Enable this if you like the feature, but don't rely on correct results. -$show_subdir_lastmod = 0; +# +#$show_subdir_lastmod = 1; -# Background color of logentry in markup -$markupLogColor = "#ffffff"; - -# Show CVS log when viewing file contents +# Show CVS log when viewing file contents? +# $show_log_in_markup = 1; -# Preformat when viewing file contents. This should be turned off +# Preformat when viewing file contents? This should be turned off # when you have files in the repository that are in a multibyte # encoding which uses HTML special characters ([<>&"]) as part of a -# multi-byte character. (such as iso-2022-jp, ShiftJIS, etc.) +# multibyte character. (such as iso-2022-jp, ShiftJIS, etc.) # Otherwise those files will get screwed up in markup. -$preformat_in_markup = ''; +# +# Note: enscript(1) highlighting is preferred over the built-in preformatting, +# ie. this has no effect if $allow_enscript is true and enscript can highlight +# the file. +# +#$preformat_in_markup = 1; -# Tabstop used to expand tabs in colored diffs. If undefined then -# tabs are always expanded to 8 spaces. -$tabstop = 8; +# Default tab width used to expand tabs to spaces in various HTMLized views. +# Note that CVSweb scans the first few lines of sources for some common editor +# directives controlling the tab width. It uses the value from them if found, +# falling back to the value of $tabstop if not. Default: 8. +# +#$tabstop = 4; -# if you wish to display absolute times in your local timezone, -# then define mytz and fill in the strings for your standard and +# If you wish to display absolute times in your local timezone, +# then define @mytz and fill in the strings for your standard and # daylight time. Note that you must also make sure the system # timezone is correctly set. -# @mytz=("EST", "EDT"); +# +#@mytz=("EST", "EDT"); -# cvsweb is friendly to caches by indicating a suitable -# last-modified timestamp. Doing this uses slightly more -# CPU so you might want to disable it if you have a slow -# server +# CVSweb is friendly to caches by sending the HTTP Last-Modified +# header corresponding to the sent content. In the case of a +# checkout, this may require running rcslog on the file solely for the +# purpose of retrieving the timestamp to be sent. If you have a slow +# server, you may want to turn this off for a small performance gain. +# $use_moddate = 1; -# Allows downloading a tarball of the current directory if set. -# Bear in mind that this allows downloading a tarball of your entire -# repository, which can take a lot of time and disk space to create! -# If you enable this, you may need to make sure that cvsweb can write to -# CVSROOT/val-tags, due to a bug in cvs. -$allow_tar = ''; +# Maximum number of filenames to pass to rlog(1) in one command. +# If you see "Failed to spawn GNU rlog" errors with directories containing +# lots of files, experiment by setting this to different values and see if +# the error still occurs. A good value to start from would be eg. 200. +# Just comment this out if you're not bitten by the problem. +# +#$file_list_len = 200; + +# Allow graphical representations of file revisions and branches with CvsGraph? +# +$allow_cvsgraph = $CMD{cvsgraph} ? 1 : 0; + +# Path to the CvsGraph configuration file. Only used if $allow_cvsgraph +# is true. Leave this empty or comment it out to make cvsgraph(1) use its +# default configuration file. Note that CVSweb will override some of the +# settings in the configuration file with command line options, see +# doGraph() and doGraphView() in cvsweb.cgi for details. +# +#$cvsgraph_config = "/etc/cvsgraph.conf"; + +# URL to the CVSHistory script. This should be absolute (but does not need +# to include the host and port if the script is on the same server as +# CVSweb). +#$cvshistory_url = "/cgi-bin/cvshistory.cgi"; + +# Whether to allow downloading a tarball or a zip of the current directory. +# While downloading of the entire repository is disallowed, depending on +# the directory this may take a lot of time and disk space. For some CVS +# versions, the user account running CVSweb needs write access to +# CVSROOT/val-tags. See also the tar, gzip and zip options below. +# +#$allow_tar = (($CMD{tar} && $CMD{gzip}) || $CMD{zip}) ? 1 : 0; # Options to pass to tar(1). -@tar_options = qw(--ignore-failed-read); - -# e.g. @tar_options = qw(--ignore-failed-read); -# GNU tar has some useful options against unexpected errors. +# For example: @tar_options = qw(--ignore-failed-read); +# GNU tar has some useful options against unexpected errors. +# Other useful options include "--owner=0" and "--group=0", see +# the tar(1) (or gtar(1)) manpage for details. +# +@tar_options = qw(); # Options to pass to gzip(1) when compressing a tarball to download. +# For example: @gzip_options = qw(-3); +# Try lower compression level than 6 (default) if you want faster +# compression, or higher for better compression. +# @gzip_options = qw(); -# e.g. @gzip_options = qw(-3); -# Try lower compression level than 6 (default) if you want faster -# compression, or higher, for better compression. - # Options to pass to zip(1) when compressing a zip archive to download. -@zip_options = qw(); - -# e.g. @zip_options = qw(-3); -# Try lower compression level than 6 (default) if you want faster -# compression, or higher, for better compression. +# For example: @zip_options = qw(-3); +# Try lower compression level than 6 (default) if you want faster +# compression, or higher for better compression. +# +@zip_options = qw(-q); # Options to pass to cvs(1). -# For cvs versions prior to 1.11, the '-l' option doesn't work; If you want -# working checkouts with an older cvs version, you'll have to make sure that -# the cvsweb user can read and write to CVSROOT/history. -@cvs_options = qw(-lf); - -push @cvs_options, '-R' if ($uname eq 'FreeBSD' || $uname eq 'OpenBSD'); -push @cvs_options, '-u' if ($uname eq 'NetBSD'); - -# Only FreeBSD's and OpenBSD's cvs(1) supports -R (read only access -# mode) option, which considerably speeds up checkouts over NFS. -# A similar effect is provided by -u on NetBSD. +# For cvs versions 1.11 to 1.11.6 (broken in < 1.11, removed in 1.11.7), you +# can use the '-l' option to prevent cvs from writing to the history file. +# For other cvs versions, either suppress history logging by using the +# LogHistory parameter in CVSROOT/config or make sure that the CVSweb user +# can read and write to CVSROOT/history. +# FreeBSD's and OpenBSD's cvs(1) has long since supported -R (read only access +# mode) option, which considerably speeds up checkouts over NFS. For other +# platforms, the -R option and the CVSREADONLYFS environment variable are +# available in cvs >= 1.12.1. A similar effect is provided by -u on NetBSD. +# +@cvs_options = qw(-f); +push @cvs_options, '-R' if ($^O eq 'freebsd' || $^O eq 'openbsd'); +push @cvs_options, '-u' if ($^O eq 'netbsd'); +# Only affects cvs >= 1.12.1, but doesn't hurt older ones. +$ENV{CVSREADONLYFS} = 1 unless exists($ENV{CVSREADONLYFS}); # Options to pass to the 'cvs annotate' command, usually the normal # @cvs_options are good enough here. +# To make annotate work against a read only repository, add -n, ie.: +# @annotate_options = (@cvs_options, '-n'); +# @annotate_options = @cvs_options; -# To make annotate work against a read only repository, add -n, e.g.: -# @annotate_options = (@cvs_options, '-n'); +# Options to pass to rcsdiff(1). +# Probably the only useful one here is -q (suppress diagnostic output). +# +@rcsdiff_options = qw(-q); + +# Enables syntax highlighting using GNU Enscript if set. +# You will need GNU Enscript version 1.6.3 or newer for this to work. +# +#$allow_enscript = $CMD{enscript} ? 1 : 0; + +# Options to pass to enscript(1). +# Do not set the -q, --language, -o or --highlight options here. +# Most useful styles are probably emacs, emacs_verbose and msvc. +# +@enscript_options = qw(--style=emacs --color=1); + +# Enscript highlight rule to filename regex mappings. The set of useful +# mappings depends on what highlight rules the system has installed. +# +%enscript_types = + ( + 'ada' => qr/\.ad(s|b|a)$/o, + 'asm' => qr/\.[Ss]$/o, + 'awk' => qr/\.awk$/o, + 'bash' => qr/\.(bash(_profile|rc)|inputrc)$/o, + 'c' => qr/\.(c|h)$/o, + 'changelog' => qr/^changelog$/io, + 'cpp' => qr/\.(c\+\+|C|H|cpp|cc|cxx)$/o, + 'csh' => qr/\.(csh(rc)?|log(in|out)|history)$/o, + 'elisp' => qr/\.e(l|macs)$/o, + 'fortran' => qr/\.[fF]$/o, + 'haskell' => qr/\.(l?h|l?g)s$/o, + 'html' => qr/\.x?html?$/o, + 'idl' => qr/\.idl$/o, + 'inf' => qr/\.inf$/io, + 'java' => qr/\.java$/o, + 'javascript' => qr/\.(js|pac)$/o, + 'ksh' => qr/\.ksh$/o, + 'm4' => qr/\.m4$/o, + 'makefile' => qr/(GNU)?[Mm]akefile(?!\.PL\b)|\.(ma?ke?|am)$/o, + 'matlab' => qr/\.m$/o, + 'nroff' => qr/\.man$/o, + 'pascal' => qr/\.p(as|p)?$/io, + 'perl' => qr/\.p(m|(er)?l)$/io, + 'postscript' => qr/\.e?ps$/io, + 'python' => qr/\.py$/o, + 'rfc' => qr/\b((rfc|draft)\..*\.txt)$/o, + 'scheme' => qr/\.(scm|scheme)$/o, + 'sh' => qr/\.sh$/o, + 'skill' => qr/\.il$/o, + 'sql' => qr/\.sql$/o, + 'states' => qr/\.st$/o, + 'synopsys' => qr/\.s(cr|yn(th)?)$/o, + 'tcl' => qr/\.tcl$/o, + 'tcsh' => qr/\.tcshrc$/o, + 'tex' => qr/\.tex$/o, + 'vba' => qr/\.vba$/o, + 'verilog' => qr/\.(v|vh)$/o, + 'vhdl' => qr/\.vhdl?$/o, + 'vrml' => qr/\.wrl$/o, + 'wmlscript' => qr/\.wmls(cript)?$/o, + 'zsh' => qr/\.(zsh(env|rc)|z(profile|log(in|out)))$/o, + ); + +# Troubleshooting: in case of problems, setting this to 1 will cause more +# error output into your web server error log. Under normal operation, +# this should be set to 0 or commented out. +# +#$DEBUG = 1; + +# Enable this to let CVSweb load extra configuration files from the "conf.d" +# subdirectory of the directory this file is located in. This enables site +# specific configuration without having to modify this "master" configuration +# file (except for enabling this functionality below :) +# +if (0) { + my $confdir = catdir(dirname(__FILE__), 'conf.d'); + if (opendir(CONFD, $confdir)) { + my @files = sort(map(catfile($confdir, $_), readdir(CONFD))); + close(CONFD); + for my $conffile (grep(-f && -r _, @files)) { + ($conffile) = ($conffile =~ /(.+\.conf)$/) or next; + do "$conffile" or config_error($conffile, $@); + } + } +} 1; -#EOF +# EOF diff --git a/en/cgi/cvsweb.conf-freebsd b/en/cgi/cvsweb.conf-freebsd index 4ed2dc145c..58642e2e1c 100644 --- a/en/cgi/cvsweb.conf-freebsd +++ b/en/cgi/cvsweb.conf-freebsd @@ -3,9 +3,9 @@ # Set up for FreeBSD repo options. # # $Idaemons: /home/cvs/cvsweb/cvsweb.conf-freebsd,v 1.5 2001/08/01 09:32:22 knu Exp $ -# $FreeBSD: www/en/cgi/cvsweb.conf-freebsd,v 1.15 2005/01/05 12:16:14 ceri Exp $ +# $FreeBSD: www/en/cgi/cvsweb.conf-freebsd,v 1.16 2006/01/19 19:53:38 ceri Exp $ -if ($uname eq 'FreeBSD') { +if ($^O eq 'freebsd') { $ENV{'RCSLOCALID'} = 'FreeBSD=CVSHeader'; $ENV{'RCSINCEXC'} = 'iFreeBSD'; } else { diff --git a/en/cgi/cvsweb.conf-netbsd b/en/cgi/cvsweb.conf-netbsd index 8d2ad27663..9f18fe577e 100644 --- a/en/cgi/cvsweb.conf-netbsd +++ b/en/cgi/cvsweb.conf-netbsd @@ -3,9 +3,9 @@ # Set up for NetBSD repo options. # # $Idaemons: /home/cvs/cvsweb/cvsweb.conf-netbsd,v 1.5 2001/08/01 09:32:22 knu Exp $ -# $FreeBSD: www/en/cgi/cvsweb.conf-netbsd,v 1.1.1.9 2002/09/30 19:48:52 scop Exp $ +# $FreeBSD: www/en/cgi/cvsweb.conf-netbsd,v 1.14 2002/09/30 20:14:06 scop Exp $ -if ($uname eq 'FreeBSD') { +if ($^O eq 'freebsd') { $ENV{'RCSLOCALID'} = 'NetBSD=Id'; $ENV{'RCSINCEXC'} = 'iNetBSD'; } else { diff --git a/en/cgi/cvsweb.conf-openbsd b/en/cgi/cvsweb.conf-openbsd index fbb6ca0595..1f9e528bf0 100644 --- a/en/cgi/cvsweb.conf-openbsd +++ b/en/cgi/cvsweb.conf-openbsd @@ -3,9 +3,9 @@ # Set up for OpenBSD repo options. # # $Idaemons: /home/cvs/cvsweb/cvsweb.conf-openbsd,v 1.5 2001/08/01 09:32:22 knu Exp $ -# $FreeBSD: www/en/cgi/cvsweb.conf-openbsd,v 1.1.1.9 2002/09/30 19:48:52 scop Exp $ +# $FreeBSD: www/en/cgi/cvsweb.conf-openbsd,v 1.12 2002/09/30 20:14:06 scop Exp $ -if ($uname eq 'FreeBSD') { +if ($^O eq 'freebsd') { $ENV{'RCSLOCALID'} = 'OpenBSD=Id'; $ENV{'RCSINCEXC'} = 'iOpenBSD'; } else {