[BACK]Return to cvsweb.cgi CVS log [TXT][DIR] Up to [cvsweb.bsd.lv] / cvsweb

Diff for /cvsweb/cvsweb.cgi between version 1.1.1.27 and 4.19

version 1.1.1.27, 2001/07/06 09:54:57 version 4.19, 2019/11/11 14:56:27
Line 1 
Line 1 
 #!/usr/bin/perl -wT  #!/usr/bin/perl
   # $Id$
   # $knu: cvsweb.cgi,v 1.299 2010/11/13 16:37:18 simon
 #  #
 # cvsweb - a CGI interface to CVS trees.  # cvsweb - a CGI interface to CVS trees.
 #  #
 # Written in their spare time by  # Written in their spare time by
 #             Bill Fenner      <fenner@FreeBSD.org>   (original work)  #             Bill Fenner          <fenner@FreeBSD.org>   (original work)
 # extended by Henner Zeller    <zeller@think.de>,  # extended by Henner Zeller        <zeller@think.de>,
 #             Henrik Nordstrom <hno@hem.passagen.se>  #             Henrik Nordstrom     <hno@hem.passagen.se>
 #             Ken Coar         <coar@Apache.Org>  #             Ken Coar             <coar@Apache.Org>
 #             Dick Balaska     <dick@buckosoft.com>  #             Dick Balaska         <dick@buckosoft.com>
 #             Akinori MUSHA    <knu@FreeBSD.org>  #             Akinori MUSHA        <knu@FreeBSD.org>
 #             Jens-Uwe Mager   <jum@helios.de>  #             Jens-Uwe Mager       <jum@helios.de>
   #             Ville Skyttä         <scop@FreeBSD.org>
   #             Vassilii Khachaturov <vassilii@tarunz.org>
 #  #
 # Based on:  # Based on:
 # * Bill Fenners cvsweb.cgi revision 1.28 available from:  # * Bill Fenners cvsweb.cgi revision 1.28 available from:
Line 17 
Line 21 
 #  #
 # Copyright (c) 1996-1998 Bill Fenner  # Copyright (c) 1996-1998 Bill Fenner
 #           (c) 1998-1999 Henner Zeller  #           (c) 1998-1999 Henner Zeller
 #           (c) 1999      Henrik Nordstrom  #           (c) 1999      Henrik Nordstrom
 #           (c) 2000-2001 Akinori MUSHA  #           (c) 2000-2002 Akinori MUSHA
   #           (c) 2002-2005 Ville Skyttä
 # All rights reserved.  # All rights reserved.
 #  #
 # Redistribution and use in source and binary forms, with or without  # Redistribution and use in source and binary forms, with or without
Line 41 
Line 46 
 # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY  # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
 # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF  # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
 # SUCH DAMAGE.  # SUCH DAMAGE.
 #  
 # $zId: cvsweb.cgi,v 1.110 2001/06/29 09:29:36 hnordstrom Exp $  
 # $Idaemons: /home/cvs/cvsweb/cvsweb.cgi,v 1.78 2001/07/06 09:49:01 knu Exp $  
 #  
 ###  
   
 require 5.000;  require 5.006;
   
 use strict;  use strict;
   use warnings;
   use filetest qw(access);
   
 use vars qw (  use vars qw (
     $cvsweb_revision    $VERSION $CheckoutMagic $MimeTypes $DEBUG
     $mydir $uname $config $allow_version_select $verbose    $config $allow_version_select
     @CVSrepositories @CVSROOT %CVSROOT %CVSROOTdescr    @CVSrepositories @CVSROOT %CVSROOT %CVSROOTdescr
     %MIRRORS %DEFAULTVALUE %ICONS %MTYPES    %MIRRORS %DEFAULTVALUE %ICONS %MTYPES
     @DIFFTYPES %DIFFTYPES @LOGSORTKEYS %LOGSORTKEYS    %DIFF_COMMANDS @DIFFTYPES %DIFFTYPES @LOGSORTKEYS %LOGSORTKEYS
     %alltags @tabcolors %fileinfo %tags @branchnames %nameprinted    %alltags %fileinfo %tags @branchnames %nameprinted
     %symrev %revsym @allrevisions %date %author @revdisplayorder    %symrev %revsym @allrevisions %date %author @revdisplayorder
     @revisions %state %difflines %log %branchpoint @revorder    @revisions %state %difflines %log %branchpoint @revorder $keywordsubstitution
     $prcgi @prcategories $re_prcategories $prkeyword $re_prkeyword $mancgi    $prcgi @prcategories $re_prcategories $prkeyword $re_prkeyword $mancgi
     $checkoutMagic $doCheckout $scriptname $scriptwhere    $doCheckout $scriptname $scriptwhere
     $where $pathinfo $Browser $nofilelinks $maycompress @stickyvars    $where $Browser $nofilelinks $maycompress @stickyvars
     %funcline_regexp $is_mod_perl    $is_links $is_lynx $is_w3m $is_msie $is_mozilla3 $is_textbased
     $is_links $is_lynx $is_w3m $is_msie $is_mozilla3 $is_textbased    %input $query $barequery $sortby $bydate $byrev $byauthor
     %input $query $barequery $sortby $bydate $byrev $byauthor    $bylog $byfile $defaultDiffType $logsort $cvstree $cvsroot
     $bylog $byfile $defaultDiffType $logsort $cvstree $cvsroot    $charset $output_filter
     $mimetype $charset $defaultTextPlain $defaultViewable    @command_path %CMD $allow_compress $backicon $diricon $fileicon
     $command_path %CMD $allow_compress    $fullname $cvstreedefault $logo $defaulttitle $address $binfileicon
     $backicon $diricon $fileicon    $long_intro $short_instruction $shortLogLen $show_author
     $fullname $newname $cvstreedefault    $tablepadding $hr_breakable $showfunc $hr_ignwhite $hr_ignkeysubst
     $body_tag $body_tag_for_src $logo $defaulttitle $address    $inputTextSize $mime_types $allow_annotate $allow_markup $allow_mailtos
     $long_intro $short_instruction $shortLogLen    $allow_log_extra $allow_dir_extra $allow_source_extra
     $show_author $dirtable $tablepadding $columnHeaderColorDefault    $edit_option_form
     $columnHeaderColorSorted $hr_breakable $showfunc $hr_ignwhite    $show_subdir_lastmod $show_log_in_markup $preformat_in_markup
     $hr_ignkeysubst $diffcolorHeading $diffcolorEmpty $diffcolorRemove    $tabstop $state $annTable $sel @ForbiddenFiles
     $diffcolorChange $diffcolorAdd $diffcolorDarkChange $difffontface    $use_descriptions %descriptions @mytz $dwhere
     $difffontsize $inputTextSize $mime_types $allow_annotate    $use_moddate $gzip_open $file_list_len
     $allow_markup $use_java_script $open_extern_window    $allow_tar @tar_options @gzip_options @zip_options @cvs_options
     $extern_window_width $extern_window_height $edit_option_form    @annotate_options @rcsdiff_options
     $show_subdir_lastmod $show_log_in_markup $preformat_in_markup $v    $HTML_DOCTYPE $HTML_META $cssurl $CSS $cvshistory_url
     $navigationHeaderColor $tableBorderColor $markupLogColor  
     $tabstop $state $annTable $sel $curbranch @HideModules  
     $module $use_descriptions %descriptions @mytz $dwhere $moddate  
     $use_moddate $has_zlib $gzip_open  
     $allow_tar @tar_options @gzip_options @zip_options @cvs_options  
     $LOG_FILESEPARATOR $LOG_REVSEPARATOR  
 );  );
   
 sub printDiffSelect($);  require Compress::Zlib;
 sub printDiffLinks($$);  use Cwd                   qw(abs_path);
 sub printLogSortSelect($);  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;
   
   # -----------------------------------------------------------------------------
   
   # All global initialization that can be done in compile time should go to
   # the BEGIN block.  Persistent environments, such as mod_perl, will benefit
   # from this.
   
   BEGIN
   {
     $VERSION = '3.1';
   
     $HTML_DOCTYPE =
       '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" ' .
       '"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">';
   
     $HTML_META = <<EOM;
   <meta name="robots" content="nofollow" />
   <meta name="generator" content="CVSweb $VERSION" />
   <meta http-equiv="Content-Style-Type" content="text/css" />
   EOM
   
     # Use MIME::Types for MIME type lookups if it's available.
     eval {
       require MIME::Types;
       $MimeTypes = MIME::Types->new(only_complete => 1);
     };
     $MimeTypes = undef if $@;
   
     $CheckoutMagic = '~checkout~';
   }
   
   # -----------------------------------------------------------------------------
   
   sub printDiffSelect();
   sub printDiffSelectStickyVars();
   sub getDiffLinks($$$);
   sub printLogSortSelect();
 sub findLastModifiedSubdirs(@);  sub findLastModifiedSubdirs(@);
 sub htmlify_sub(&$);  sub htmlify_sub(&$);
 sub htmlify($;$);  sub htmlify($;$);
 sub spacedHtmlText($;$);  sub spacedHtmlText($;$);
 sub link($$);  sub link($$);
 sub revcmp($$);  sub revcmp($$);
 sub fatal($$);  sub fatal($$@);
 sub redirect($);  sub config_error($$);
   sub redirect($;$);
 sub safeglob($);  sub safeglob($);
 sub search_path($);  sub search_path($);
 sub getMimeTypeFromSuffix($);  sub getMimeType($;$);
 sub head($;$);  sub head($;$);
 sub scan_directives(@);  sub scan_directives(@);
   sub openOutputFilter();
 sub doAnnotate($$);  sub doAnnotate($$);
 sub doCheckout($$);  sub doCheckout($$$);
 sub cvswebMarkup($$$);  sub cvswebMarkup($$$$$$;$);
 sub viewable($);  sub viewable($);
 sub doDiff($$$$$$);  sub doDiff($$$$$$);
 sub getDirLogs($$@);  sub getDirLogs($$@);
 sub readLog($;$);  sub readLog($;$);
 sub printLog($;$);  sub printLog($$$;$$);
 sub doLog($);  sub doLog($);
 sub flush_diff_rows($$$$);  sub flush_diff_rows($$$$);
 sub human_readable_diff($);  sub human_readable_diff($$);
 sub navigateHeader($$$$$);  sub navigateHeader($$$$$;$);
 sub plural_write($$);  sub plural_write($$);
 sub readableTime($$);  sub readableTime($$);
 sub clickablePath($$);  sub clickablePath($$);
Line 125  sub chooseMirror();
Line 173  sub chooseMirror();
 sub fileSortCmp();  sub fileSortCmp();
 sub download_url($$;$);  sub download_url($$;$);
 sub download_link($$$;$);  sub download_link($$$;$);
 sub toggleQuery($$);  sub display_url($$;$);
 sub urlencode($);  sub display_link($$;$$);
   sub history_link($$;$);
   sub toggleQuery($;$);
 sub htmlquote($);  sub htmlquote($);
 sub htmlunquote($);  sub htmlunquote($);
 sub hrefquote($);  sub uri_escape_path($);
 sub http_header(;$);  sub http_header(;$$);
 sub html_header($);  sub html_header($;$);
 sub html_footer();  sub html_footer();
 sub link_tags($);  sub link_tags($);
 sub forbidden_module($);  sub forbidden($);
   sub startproc(@);
   sub runproc(@);
   sub checkout_to_temp($$$);
   
 ##### Start of Configuration Area ########  # Get rid of unsafe environment vars.  Don't do this in the BEGIN block
 delete $ENV{PATH};  # (think mod_perl)...
   delete(@ENV{qw(PATH IFS CDPATH ENV BASH_ENV)});
   
 $cvsweb_revision = '1.110' . '.' . (split(/ /,  # Location of the configuration file inside the web server chroot:
  q$Idaemons: /home/cvs/cvsweb/cvsweb.cgi,v 1.78 2001/07/06 09:49:01 knu Exp $  $config = '/conf/cvsweb/cvsweb.conf';
 ))[2];  
   
 use File::Basename;  ######## Configuration parameters #########
   
 ($mydir) = (dirname($0) =~ /(.*)/); # untaint  @CVSrepositories = @CVSROOT = %CVSROOT = %MIRRORS = %DEFAULTVALUE = %ICONS =
     %MTYPES = %tags = %alltags = %fileinfo = %DIFF_COMMANDS = ();
   
 # == EDIT this ==  $cvstreedefault = $logo = $defaulttitle =
 # Locations to search for user configuration, in order:    $address = $long_intro = $short_instruction = $shortLogLen = $show_author =
 for (    $tablepadding = $hr_breakable = $showfunc = $hr_ignwhite =
      "$mydir/cvsweb.conf",    $hr_ignkeysubst = $inputTextSize = $mime_types = $allow_annotate =
      '/usr/local/etc/cvsweb/cvsweb.conf'    $allow_markup = $allow_compress = $edit_option_form =
     ) {    $show_subdir_lastmod = $show_log_in_markup = $preformat_in_markup =
     if (defined($_) && -r $_) {    $tabstop = $use_moddate = $gzip_open = $DEBUG =
         $config = $_;    $cvshistory_url = $allow_tar = undef;
         last;  
     }  
 }  
   
 # == Configuration defaults ==  $allow_version_select = $allow_mailtos = $allow_log_extra = 1;
 # Defaults for configuration variables that shouldn't need  
 # to be configured..  
 $allow_version_select = 1;  
   
 ##### End of Configuration Area   ########  @DIFFTYPES = qw(h H u c);
   
 ######## Configuration variables #########  
 # These are defined to allow checking with perl -cw  
 @CVSrepositories = @CVSROOT = %CVSROOT =  
 %MIRRORS = %DEFAULTVALUE = %ICONS = %MTYPES =  
 %tags = %alltags = @tabcolors = %fileinfo = ();  
 $cvstreedefault = $body_tag = $body_tag_for_src =  
 $logo = $defaulttitle = $address =  
 $long_intro = $short_instruction = $shortLogLen =  
 $show_author = $dirtable = $tablepadding = $columnHeaderColorDefault =  
 $columnHeaderColorSorted = $hr_breakable = $showfunc = $hr_ignwhite =  
 $hr_ignkeysubst = $diffcolorHeading = $diffcolorEmpty = $diffcolorRemove =  
 $diffcolorChange = $diffcolorAdd = $diffcolorDarkChange = $difffontface =  
 $difffontsize = $inputTextSize = $mime_types = $allow_annotate =  
 $allow_markup = $use_java_script = $open_extern_window =  
 $extern_window_width = $extern_window_height = $edit_option_form =  
 $show_subdir_lastmod = $show_log_in_markup = $v =  
 $navigationHeaderColor = $tableBorderColor = $markupLogColor =  
 $tabstop = $use_moddate = $moddate = $gzip_open = undef;  
   
 $LOG_FILESEPARATOR = q/^={77}$/;  
 $LOG_REVSEPARATOR = q/^-{28}$/;  
   
 @DIFFTYPES = qw(h H u c s);  
 @DIFFTYPES{@DIFFTYPES} = (  @DIFFTYPES{@DIFFTYPES} = (
                           {    {
                            'descr'   => 'colored',      'descr'   => 'colored',
                            'opts'    => [ '-u' ],      'opts'    => ['-u'],
                            'colored' => 1,      'colored' => 1,
                           },    },
                           {    {
                            'descr'   => 'long colored',      'descr'   => 'long colored',
                            'opts'    => [ '--unified=15' ],      'opts'    => ['--unified=15'],
                            'colored' => 1,      'colored' => 1,
                           },    },
                           {    {
                            'descr'   => 'unified',      'descr'   => 'unified',
                            'opts'    => [ '-u' ],      'opts'    => ['-u'],
                            'colored' => 0,      'colored' => 0,
                           },    },
                           {    {
                            'descr'   => 'context',      'descr'   => 'context',
                            'opts'    => [ '-c' ],      'opts'    => ['-c'],
                            'colored' => 0,      'colored' => 0,
                           },    },
                           {  );
                            'descr'   => 'side by side',  
                            'opts'    => [ '--side-by-side', '--width=164' ],  
                            'colored' => 0,  
                           },  
                          );  
   
 @LOGSORTKEYS = qw(cvs date rev);  @LOGSORTKEYS = qw(cvs date rev);
 @LOGSORTKEYS{@LOGSORTKEYS} = (  @LOGSORTKEYS{@LOGSORTKEYS} = (
                               {    { descr => 'Not sorted',  },
                                'descr' => 'Not sorted',    { descr => 'Commit date', },
                               },    { descr => 'Revision',    },
                               {  );
                                'descr' => 'Commit date',  
                               },  
                               {  
                                'descr' => 'Revision',  
                               },  
                              );  
   
   ##### End of configuration parameters #####
   
 ##### End of configuration variables #####  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: <code>%s</code>',
                $ENV{PATH_INFO});
   }
   if ($ENV{SCRIPT_NAME}) {
     ($scriptname) = ($ENV{SCRIPT_NAME} =~ VALID_PATH)
       or fatal('500 Internal Error',
                'Illegal SCRIPT_NAME in environment: <code>%s</code>',
                $ENV{SCRIPT_NAME});
   }
   
 use Time::Local;  $scriptname    = '' unless defined($scriptname);
 use IPC::Open2;  
   
 # Check if the zlib C library interface is installed, and if yes  $where         =  $pathinfo;
 # we can avoid using the extra gzip process.  $doCheckout    =  $where =~ s|^/$CheckoutMagic/|/|o;
 eval {  $where         =~ s|^/||;
         require Compress::Zlib;  $scriptname    =~ s|^/*|/|;
 };  
 $has_zlib = !$@;  
   
 $verbose = $v;  
 $checkoutMagic = "~checkout~";  
 $pathinfo = defined($ENV{PATH_INFO}) ? $ENV{PATH_INFO} : '';  
 $where = $pathinfo;  
 $doCheckout = ($where =~ m|^/$checkoutMagic/|);  
 $where =~ s|^/$checkoutMagic/|/|;  
 $where =~ s|^/||;  
 $scriptname = defined($ENV{SCRIPT_NAME}) ? $ENV{SCRIPT_NAME} : '';  
 $scriptname =~ s|^/*|/|;  
   
 # Let's workaround thttpd's stupidity..  # Let's workaround thttpd's stupidity..
 if ($scriptname =~ m|/$|) {  if ($scriptname =~ m|/$|) {
     $pathinfo .= '/';    $pathinfo .= '/';
     my $re = quotemeta $pathinfo;    my $re = quotemeta $pathinfo;
     $scriptname =~ s/$re$//;    $scriptname =~ s/$re$//;
 }  }
   
 $scriptwhere = $scriptname;  # $scriptname : the URI escaped path to this script
 $scriptwhere .= '/' . urlencode($where);  # $where      : the path in the CVS repository (without leading /, or only /)
 $where = '/' if ($where eq '');  # $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  $Browser     = $ENV{HTTP_USER_AGENT} || '';
 # per file, so disable the link at the icon  $is_links    = ($Browser =~ m`^E?Links `);
 # in this case:  $is_lynx     = ($Browser =~ m`^Lynx/`i);
 $Browser = $ENV{HTTP_USER_AGENT} || '';  $is_w3m      = ($Browser =~ m`^w3m/`i);
 $is_links = ($Browser =~ m`^Links `);  $is_msie     = ($Browser =~ m`MSIE`);
 $is_lynx = ($Browser =~ m`^Lynx/`i);  
 $is_w3m = ($Browser =~ m`^w3m/`i);  
 $is_msie = ($Browser =~ m`MSIE`);  
 $is_mozilla3 = ($Browser =~ m`^Mozilla/[3-9]`);  $is_mozilla3 = ($Browser =~ m`^Mozilla/[3-9]`);
   
 $is_textbased = ($is_links || $is_lynx || $is_w3m);  $is_textbased = ($is_links || $is_lynx || $is_w3m);
Line 289  $nofilelinks = $is_textbased;
Line 303  $nofilelinks = $is_textbased;
 # display garbage then :-/  # display garbage then :-/
 # Turn off gzip if running under mod_perl and no zlib is available,  # Turn off gzip if running under mod_perl and no zlib is available,
 # piping does not work as expected inside the server.  # piping does not work as expected inside the server.
 $maycompress = (((defined($ENV{HTTP_ACCEPT_ENCODING})  $maycompress = (
                  && $ENV{HTTP_ACCEPT_ENCODING} =~ m`gzip`)    ((defined($ENV{HTTP_ACCEPT_ENCODING})
                  || $is_mozilla3)      && $ENV{HTTP_ACCEPT_ENCODING} =~ /gzip/)
                 && !$is_msie     || $is_mozilla3)
                 && !($is_mod_perl && !$has_zlib));    && !$is_msie
     && !(defined($ENV{MOD_PERL}))
   );
   
 # put here the variables we need in order  # Parameters that will be sticky in all constructed links/query strings.
 # to hold our state - they will be added (with  @stickyvars =
 # their current value) to any link/query string    qw(cvsroot hideattic ignorecase sortby logsort f only_with_tag ln
 # you construct       hidecvsroot hidenonreadable);
 @stickyvars = qw(cvsroot hideattic sortby logsort f only_with_tag);  
   
   #
   # Load configuration.
   #
 if (-f $config) {  if (-f $config) {
    require $config    do "$config" or config_error($config, $@);
      || &fatal("500 Internal Error",  
                sprintf('Error in loading configuration file: %s<BR><BR>%s<BR>',  
                        $config, &htmlify($@)));  
 } else {  } else {
    &fatal("500 Internal Error",    fatal("500 Internal Error",
           'Configuration not found.  Set the variable <code>$config</code> '          'Configuration not found.  Set the parameter <code>$config</code> in cvsweb.cgi to your <b>cvsweb.conf</b> configuration file first.');
           . 'in cvsweb.cgi to your <b>cvsweb.conf</b> 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("<link rel=\"stylesheet\" type=\"text/css\" href=\"%s\" />\n",
             htmlquote($cssurl)) : '';
   
   # --- input parameters
   
   my %query = ();
   if (defined($ENV{QUERY_STRING})) {
     for my $p (split(/[;&]+/, $ENV{QUERY_STRING})) {
       next unless $p;
       $p =~ y/+/ /;
       my ($key, $val) = split(/=/, $p, 2);
       next unless defined($key);
       $key = uri_unescape($key);
       $key =~ /([^a-z_12-])/ and fatal('404 Not Found',
         'Invalid character "%s" in query parameter "%s"', $1, $key);
       if (defined $val) {
         $val = uri_unescape($val);
         $val =~ /([^a-zA-Z_01-9.\/-])/ and fatal('404 Not Found',
           'Invalid character "%s" in the value "%s" of the query parameter "%s"',
           $1, $val, $key);
       } else {
         $val = 1;
       }
       $query{$key} = $val;
     }
   }
   
 undef %input;  undef %input;
 $query = $ENV{QUERY_STRING};  
   
 if (defined($query) && $query ne '') {  my $t;
     foreach (split(/&/, $query)) {  for my $p (qw(hideattic hidecvsroot hidenonreadable ignorecase ln copt
         y/+/ /;                options tarball)) {
         s/%(..)/sprintf("%c", hex($1))/ge;      # unquote %-quoted    $t = $query{$p};
         if (/(\S+)=(.*)/) {    if (defined($t)) {
             $input{$1} = $2 if ($2 ne "");      ($input{$p}) = ($t =~ /^([01]|on)$/)
         }        or fatal('500 Internal Error',
         else {                 'Invalid boolean value: <code>%s=%s</code>', $p, $t);
             $input{$_}++;    }
         }  }
   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: <code>%s=%s</code>', $p, $t);
       if (defined($tag)) {
         ($tag) = ($tag =~ VALID_TAG1)
           or fatal('500 Internal Error',
                    'Invalid tag/branch name in revision: <code>%s=%s</code>',
                    $p, $t);
         ($tag) = ($tag =~ VALID_TAG2)
           or fatal('500 Internal Error',
                    'Invalid tag/branch name in revision: <code>%s=%s</code>',
                    $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: <code>%s</code>', $t);
     ($input{only_with_tag}) = ($t =~ VALID_TAG2)
       or fatal('500 Internal Error',
                'Invalid tag/branch name: <code>%s</code>', $t);
   }
   $t = $query{logsort};
   if (defined($t)) {
     ($input{logsort}) = ($t =~ /^(cvs|date|rev)$/)
       or fatal('500 Internal Error',
                'Unsupported log sort key: <code>%s</code>', $t);
   }
   $t = $query{f};
   if (defined($t)) {
     ($input{f}) = ($t =~ /^(([hH]|[ucs]c?)|ext\d*)$/)
       or fatal('500 Internal Error',
                'Unsupported diff format: <code>%s</code>', $t);
   }
   $t = $query{sortby};
   if (defined($t)) {
     ($input{sortby}) = ($t =~ /^(file|date|rev|author|log)$/)
       or fatal('500 Internal Error',
                'Unsupported dir sort key: <code>%s</code>', $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: <code>%s</code>', $t);
   }
   $t = $query{cvsroot};
   if (defined($t)) {
     ($input{cvsroot}) = ($t =~ /^([[:print:]]+)$/)
       or fatal('500 Internal Error',
                'Invalid symbolic CVS root name: <code>%s</code>', $t);
   }
   $t = $query{path};
   if (defined($t)) {
     ($input{path}) = ($t =~ VALID_PATH)
       or fatal('500 Internal Error',
                'Invalid path: <code>%s</code>', $t);
   }
   undef($t);
   undef(%query);
   
 # For backwards compability, set only_with_tag to only_on_branch if set.  # --- end input parameters
 $input{only_with_tag} = $input{only_on_branch}  
     if (defined($input{only_on_branch}));  
   
 $DEFAULTVALUE{'cvsroot'} = $cvstreedefault;  #
   # CVS roots
   #
   my $rootfound = 0;
   for (my $i = 0; $i < scalar(@CVSrepositories); $i += 2) {
     my $key = $CVSrepositories[$i];
     my ($descr, $root) = @{$CVSrepositories[$i+1]};
     $root = canonpath($root);
     unless (-d $root) {
       warn("Root '$root' defined in \@CVSrepositories is not a directory, " .
            'entry ignored');
       next;
     }
     $rootfound ||= 1;
     $cvstreedefault = $key unless defined($cvstreedefault);
     $CVSROOTdescr{$key} = $descr;
     $CVSROOT{$key} = $root;
     push(@CVSROOT, $key);
   }
   unless ($rootfound) {
     fatal('500 Internal Error',
           'No valid CVS roots found!  See <code>@CVSrepositories</code> in ' .
           'the configuration file (<code>%s</code>).',
           $config);
   }
   undef $rootfound;
   
 foreach (keys %DEFAULTVALUE)  #
 {  # Default CVS root
     # replace not given parameters with the default parameters  #
     if (!defined($input{$_}) || $input{$_} eq "") {  if (!defined($CVSROOT{$cvstreedefault})) {
         # Empty Checkboxes in forms return -- nothing. So we define a helper    fatal("500 Internal Error",
         # variable in these forms (copt) which indicates that we just set          '<code>$cvstreedefault</code> points to a repository (%s) not ' .
         # parameters with a checkbox          'defined in <code>@CVSrepositories</code> in your configuration ' .
         if (!defined($input{"copt"})) {          'file (<code>%s</code>).',
             # 'copt' isn't defined --> empty input is not the result          $cvstreedefault,
             # of empty input checkbox --> set default          $config);
             $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"));  
         }  
     }  
 }  }
   
   $DEFAULTVALUE{cvsroot} = $cvstreedefault;
   
   while (my ($key, $defval) = each %DEFAULTVALUE) {
   
     # Replace not given parameters with defaults.
     next unless (defined($defval) && $defval =~ /\S/ && !defined($input{$key}));
   
     # Empty checkboxes in forms return nothing, so we define a helper parameter
     # in these forms (copt) which indicates that we just set parameters with a
     # checkbox.
     if ($input{copt}) {
   
       # 'copt' is set -> the result of empty input checkbox
       # -> set to zero (disable) if default is a boolean (0|1).
       $input{$key} = 0 if ($defval eq '0' || $defval eq '1');
   
     } else {
   
       # 'copt' isn't set --> empty input is not the result
       # of empty input checkbox --> set default.
       $input{$key} = $defval;
     }
   }
   
 $barequery = "";  $barequery = "";
 my @barequery;  my @barequery;
 foreach (@stickyvars) {  foreach (@stickyvars) {
     # construct a query string with the sticky non default parameters set  
     if (defined($input{$_}) && $input{$_} ne '' &&    # construct a query string with the sticky non default parameters set
         !(defined($DEFAULTVALUE{$_}) && $input{$_} eq $DEFAULTVALUE{$_})) {    if (defined($input{$_})
         push @barequery, join('=', urlencode($_), urlencode($input{$_}));        && !(defined($DEFAULTVALUE{$_}) && $input{$_} eq $DEFAULTVALUE{$_}))
     }    {
       push(@barequery, join('=', uri_escape($_), uri_escape($input{$_})));
     }
 }  }
   
 # is there any query ?  # is there any query ?
 if (@barequery) {  if (@barequery) {
     $barequery = join('&', @barequery);    $barequery = join (';', @barequery);
     $query = "?$barequery";    $query     = "?$barequery";
     $barequery = "&$barequery";    $barequery = ";$barequery";
   } else {
     $query = "";
 }  }
 else {  
     $query = "";  
 }  
 undef @barequery;  undef @barequery;
   
 if (defined($input{path})) {  if (defined($input{path})) {
     redirect("$scriptname/$input{path}$query");    redirect("$scriptname/$input{path}$query");
 }  }
   
 # get actual parameters  # get actual parameters
 $sortby = $input{"sortby"};  {
 $bydate = 0;    my $sortby = $input{sortby} || 'file';
 $byrev = 0;    $bydate    = 0;
 $byauthor = 0;    $byrev     = 0;
 $bylog = 0;    $byauthor  = 0;
 $byfile = 0;    $bylog     = 0;
 if ($sortby eq "date") {    $byfile    = 0;
     if ($sortby eq 'date') {
     $bydate = 1;      $bydate = 1;
 }    } elsif ($sortby eq 'rev') {
 elsif ($sortby eq "rev") {  
     $byrev = 1;      $byrev = 1;
 }    } elsif ($sortby eq 'author') {
 elsif ($sortby eq "author") {  
     $byauthor = 1;      $byauthor = 1;
 }    } elsif ($sortby eq 'log') {
 elsif ($sortby eq "log") {  
     $bylog = 1;      $bylog = 1;
 }    } else {
 else {  
     $byfile = 1;      $byfile = 1;
     }
 }  }
   
 $defaultDiffType = $input{'f'};  $defaultDiffType = $input{f};
   
 $logsort = $input{'logsort'};  $logsort = $input{logsort};
   
 my @tmp = @CVSrepositories;  
 my @pair;  
   
 while (@pair = splice(@tmp, 0, 2)) {  
     my($key, $val) = @pair;  
     my($descr, $cvsroot) = @$val;  
   
     next if !-d $cvsroot;  
   
     $CVSROOTdescr{$key} = $descr;  
     $CVSROOT{$key} = $cvsroot;  
     push @CVSROOT, $key;  
 }  
 undef @tmp;  
 undef @pair;  
   
 ## Default CVS-Tree  
 if (!defined($CVSROOT{$cvstreedefault})) {  
    &fatal("500 Internal Error",  
           "<code>\$cvstreedefault</code> points to a repository "  
           . "not defined in <code>%CVSROOT</code> "  
           . "(edit your configuration file $config)");  
 }  
   
 # alternate CVS-Tree, configured in cvsweb.conf  # alternate CVS-Tree, configured in cvsweb.conf
 if ($input{'cvsroot'} && $CVSROOT{$input{'cvsroot'}}) {  if ($input{cvsroot} && $CVSROOT{$input{cvsroot}}) {
     $cvstree = $input{'cvsroot'};    $cvstree = $input{cvsroot};
 } else {  } else {
     $cvstree = $cvstreedefault;    $cvstree = $cvstreedefault;
 }  }
   
 $cvsroot = $CVSROOT{$cvstree};  $cvsroot = $CVSROOT{$cvstree};
   
 # create icons out of description  # create icons out of description
 my $k;  foreach my $k (keys %ICONS) {
 foreach $k (keys %ICONS) {    my ($itxt, $ipath, $iwidth, $iheight) = @{$ICONS{$k}};
     no strict 'refs';    no strict 'refs';
     my ($itxt,$ipath,$iwidth,$iheight) = @{$ICONS{$k}};    if ($ipath) {
     if ($ipath) {      ${"${k}icon"} =
         ${"${k}icon"} = sprintf('<IMG SRC="%s" ALT="%s" BORDER="0" WIDTH="%d" HEIGHT="%d">',        sprintf('<img src="%s" alt="%s" border="0" width="%d" height="%d" />',
                                 hrefquote($ipath), htmlquote($itxt), $iwidth, $iheight)                htmlquote($ipath), htmlquote($itxt), $iwidth, $iheight);
     }    } else {
     else {      ${"${k}icon"} = $itxt;
         ${"${k}icon"} = $itxt;    }
     }  
 }  }
 undef $k;  
   
 my $config_cvstree = "$config-$cvstree";  my $config_cvstree = "$config-$cvstree";
   
 # Do some special configuration for cvstrees  # Do some special configuration for cvstrees
 if (-f $config_cvstree) {  if (-f $config_cvstree) {
    require $config_cvstree    do "$config_cvstree"
      || &fatal("500 Internal Error",      or fatal("500 Internal Error",
                sprintf('Error in loading configuration file: %s<BR><BR>%s<BR>',               'Error in loading configuration file: %s<br /><br />%s<br />',
                        $config_cvstree, &htmlify($@)));               $config_cvstree, $@);
 }  }
 undef $config_cvstree;  undef $config_cvstree;
   
 $re_prcategories = '(?:' . join('|', @prcategories) . ')' if @prcategories;  $re_prcategories  = '(?:' . join ('|', @prcategories) . ')' if @prcategories;
 $re_prkeyword = quotemeta($prkeyword) if defined($prkeyword);  $re_prkeyword     = quotemeta($prkeyword) if defined($prkeyword);
 $prcgi .= '%s' if defined($prcgi) && $prcgi !~ /%s/;  $prcgi           .= '%s' if defined($prcgi) && $prcgi !~ /%s/;
   
 $fullname = "$cvsroot/$where";  $fullname         = catfile($cvsroot, $where);
 $mimetype = &getMimeTypeFromSuffix ($fullname);  
 $defaultTextPlain = ($mimetype eq "text/plain");  
 $defaultViewable = $allow_markup && viewable($mimetype);  
   
 my $rewrite = 0;  my $rewrite = 0;
   
 if ($pathinfo =~ m|//|) {  if ($pathinfo =~ m|//|) {
     $pathinfo =~ y|/|/|s;    $pathinfo =~ y|/|/|s;
     $rewrite = 1;    $rewrite = 1;
 }  }
   if (-d $fullname) {
 if (-d $fullname && $pathinfo !~ m|/$|) {    if ($pathinfo !~ m|/$|) {
     $pathinfo .= '/';      $pathinfo .= '/';
     $rewrite = 1;      $rewrite   = 1;
     }
   } elsif ($pathinfo =~ m|/$|) {
     chop $pathinfo;
     $rewrite = 1;
 }  }
   
 if (!-d $fullname && $pathinfo =~ m|/$|) {  
     chop $pathinfo;  
     $rewrite = 1;  
 }  
   
 if ($rewrite) {  if ($rewrite) {
     redirect($scriptname . urlencode($pathinfo) . $query);    redirect($scriptname . uri_escape_path($pathinfo) . $query, 1);
 }  }
   
 undef $rewrite;  undef $rewrite;
   
   undef $pathinfo;
   
 if (!-d $cvsroot) {  if (!-d $cvsroot) {
     &fatal("500 Internal Error",'$CVSROOT not found!<P>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!<p>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:([^/]*):;  fatal('403 Forbidden', 'Access to %s forbidden.', $where)
 $module = $1;    if forbidden($fullname);
 if ($module && &forbidden_module($module)) {  
     &fatal("403 Forbidden", "Access to $where forbidden.");  
 }  
   
 #  #
 # Handle tarball downloads before any headers are output.  # Handle tarball downloads before any headers are output.
 #  #
 if ($input{tarball}) {  if ($input{tarball}) {
     &fatal("403 Forbidden", "Downloading tarballs is prohibited.")    fatal('403 Forbidden', 'Downloading tarballs is prohibited.')
       unless $allow_tar;      unless $allow_tar;
     my($module) = ($where =~ m,^/?(.*),);       # untaint  
     $module =~ s,/([^/]*)$,,;  
     my($ext) = ($1 =~ /(\.tar\.gz|\.zip)$/);  
     my($basedir) = ($module =~ m,([^/]+)$,);  
   
     if ($basedir eq '' || $module eq '') {    my ($module)  =  ($where =~ m,^/?(.*),);    # untaint
         &fatal("500 Internal Error", "You cannot download the top level directory.");    $module       =~ s,/([^/]*)$,,;
     }    my ($ext)     =  ($1 =~ /(\.t(?:ar\.)?gz|\.zip)$/);
     my ($basedir) =  ($module =~ m,([^/]+)$,);
   
     my $tmpdir = "/tmp/.cvsweb.$$." . int(time);    if ($basedir eq '' || $module eq '') {
       fatal('500 Internal Error',
             'You cannot download the top level directory.');
     }
   
     mkdir($tmpdir, 0700)    my $istar = ($ext eq '.tar.gz' || $ext eq '.tgz');
       or &fatal("500 Internal Error", "Unable to make temporary directory: $!");    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})    my @fatal;
       ? $input{only_with_tag} : "HEAD";    my $tag = $input{only_with_tag} || 'HEAD';
     $tag = 'HEAD' if ($tag eq 'MAIN');
   
     if (system $CMD{cvs}, @cvs_options, '-Qd', $cvsroot, 'export', '-r', $tag, '-d', "$tmpdir/$basedir", $module) {    my @cmd =
         @fatal = ("500 Internal Error", "cvs co failure: $!: $module");      ($CMD{cvs}, @cvs_options, '-Qd', $cvsroot, 'export', '-r', $tag,
     } else {       '-d', $basedir, $module);
         $| = 1; # Essential to get the buffering right.    my $export_err;
     my ($errcode, $err) = runproc(\@cmd, '2>', \$export_err);
     if ($errcode) {
       @fatal =
         ('500 Internal Error',
          'Export failure (exit status %s), output: <pre>%s</pre>',
          $errcode, $err || $export_err);
   
         if ($ext eq '.tar.gz') {    } else {
             print "Content-type: application/x-gzip\r\n\r\n";  
   
             system "$CMD{tar} @tar_options -cf - -C $tmpdir $basedir | $CMD{gzip} @gzip_options -c"      $| = 1;    # Essential to get the buffering right.
               and @fatal = ("500 Internal Error", "tar zc failure: $!: $basedir");      local (*TAR_OUT);
         } elsif ($ext eq '.zip' && $CMD{zip}) {  
             print "Content-type: application/zip\r\n\r\n";  
   
             system "cd $tmpdir && $CMD{zip} @zip_options -r - $basedir"      my (@cmd, $ctype);
               and @fatal = ("500 Internal Error", "zip failure: $!: $basedir");      if ($istar) {
         } else {        my @tar = ($CMD{tar}, @tar_options, '-cf', '-', $basedir);
             @fatal = ("500 Internal Error", "unsupported file type");        my @gzip = ($CMD{gzip}, @gzip_options, '-c');
         }        push(@cmd, \@tar, '|', \@gzip);
         $ctype = 'application/x-gzip';
       } elsif ($iszip) {
         my @zip = ($CMD{zip}, @zip_options, '-r', '-', $basedir);
         push(@cmd, \@zip, \'');
         $ctype = 'application/zip';
     }      }
       push(@cmd, '>pipe', \*TAR_OUT);
   
     system $CMD{rm}, '-rf', $tmpdir if -d $tmpdir;      my ($h, $err) = startproc(@cmd);
       if ($h) {
         print "Content-Type: $ctype\r\n\r\n";
         local $/ = undef;
         print <TAR_OUT>;
         $h->finish();
       } else {
         @fatal = ('500 Internal Error',
                   '%s failure (exit status %s), output: <pre>%s</pre>',
                   $istar ? 'Tar' : 'Zip', $? >> 8 || -1, $err);
       }
     }
   
     &fatal(@fatal) if @fatal;    # Clean up.
     chdir("..");
     rmtree($tmpexportdir);
   
     exit;    &fatal(@fatal) if @fatal;
   
     exit;
 }  }
   
 ##############################  ##############################
 # View a directory  # View a directory
 ###############################  ###############################
 if (-d $fullname) {  if (-d $fullname) {
         my $dh = do {local(*DH);};  
         opendir($dh, $fullname) || &fatal("404 Not Found","$where: $!");  
         my @dir = readdir($dh);  
         closedir($dh);  
         my @subLevelFiles = findLastModifiedSubdirs(@dir)  
             if ($show_subdir_lastmod);  
         getDirLogs($cvsroot,$where,@subLevelFiles);  
   
         if ($where eq '/') {    my $dh = do { local (*DH); };
             html_header($defaulttitle);    opendir($dh, $fullname) or fatal("404 Not Found", '%s: %s', $where, $!);
             $long_intro =~ s/!!CVSROOTdescr!!/$CVSROOTdescr{$cvstree}/g;    my @dir = grep(!forbidden(catfile($fullname, $_)), readdir($dh));
             print $long_intro;    closedir($dh);
         }    my @subLevelFiles = findLastModifiedSubdirs(@dir) if $show_subdir_lastmod;
         else {    my @unreadable = getDirLogs($cvsroot, $where, @subLevelFiles);
             html_header($where);  
             print $short_instruction;  
         }  
   
         my $descriptions;    if ($where eq '/') {
         if (($use_descriptions) && open (DESC, "<$cvsroot/CVSROOT/descriptions")) {      html_header($defaulttitle);
             while (<DESC>) {      $long_intro =~ s/!!CVSROOTdescr!!/$CVSROOTdescr{$cvstree}/g;
                 chomp;      print $long_intro;
                 my ($dir,$description) = /(\S+)\s+(.*)/;    } else {
                 $descriptions{$dir} = $description;      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: <code>%s</code>', $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 <CVS_OUT>;
         } else {
           print "<p>\n";
           while (<CVS_OUT>) {
             chomp;
             print htmlquote($_), '<br />';
           }
           print "</p>";
         }
         $h->finish();
       }
       print $short_instruction;
     }
   
         print "<P><a name=\"dirlist\"></a>\n";    if ($use_descriptions &&
         # give direct access to dirs        open(DESC, catfile($cvsroot, 'CVSROOT', 'descriptions'))) {
         if ($where eq '/') {      while (<DESC>) {
             chooseMirror();        chomp;
             chooseCVSRoot();        my ($dir, $description) = /(\S+)\s+(.*)/;
         }        $descriptions{$dir} = $description;
         else {      }
             print "<p>Current directory: <b>", &clickablePath($where,0), "</b>\n";      close(DESC);
     }
   
             print "<P>Current tag: <B>", $input{only_with_tag}, "</b>\n" if    print "<p><a name=\"dirlist\"></a></p>\n";
                 $input{only_with_tag};  
   
         }    # give direct access to dirs
     if ($where eq '/') {
       chooseMirror();
       chooseCVSRoot();
   
     } else {
       print '<p>Current directory: <b>', clickablePath($where, 0), '</b>';
       if ($cvshistory_url) {
         (my $d = $where) =~ s|^/*(.*?)/*$|$1|;
         print ' - ', history_link($d, '');
       }
       print "</p>\n";
       print "<p>Current tag: <b>", htmlquote($input{only_with_tag}), "</b></p>\n"
         if $input{only_with_tag};
     }
   
         print "<HR NOSHADE>\n";    print "<hr />\n";
         # Using <MENU> 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 = 0;    my $infocols = 1;
         if ($dirtable) {  
             if (defined($tableBorderColor)) {  
                 # Can't this be done by defining the border for the inner table?  
                 print "<table border=0 cellpadding=0 width=\"100%\"><tr><td bgcolor=\"$tableBorderColor\">";  
             }  
             print "<table  width=\"100%\" border=0 cellspacing=1 cellpadding=$tablepadding>\n";  
             $infocols++;  
             printf '<tr><th align=left bgcolor="%s">',  
               $byfile ? $columnHeaderColorSorted : $columnHeaderColorDefault;  
             if ($byfile) {  
                 print 'File';  
             } else {  
                 print &link('File', sprintf('./%s#dirlist',  
                                             &toggleQuery("sortby", "file")));  
             }  
             print "</th>";  
             # do not display the other column-headers, if we do not have any files  
             # with revision information:  
             if (scalar(%fileinfo)) {  
                 $infocols++;  
                 printf '<th align=left bgcolor="%s">',  
                   $byrev ? $columnHeaderColorSorted : $columnHeaderColorDefault;  
                 if ($byrev) {  
                     print 'Rev.';  
                 } else {  
                     print &link('Rev.', sprintf('./%s#dirlist',  
                                                 &toggleQuery("sortby", "rev")));  
                 }  
                 print "</th>";  
                 $infocols++;  
                 printf '<th align=left bgcolor="%s">',  
                   $bydate ? $columnHeaderColorSorted : $columnHeaderColorDefault;  
                 if ($bydate) {  
                     print 'Age';  
                 } else {  
                     print &link('Age', sprintf('./%s#dirlist',  
                                                &toggleQuery("sortby", "date")));  
                 }  
                 print "</th>";  
                 if ($show_author) {  
                     $infocols++;  
                     printf '<th align=left bgcolor="%s">',  
                       $byauthor ? $columnHeaderColorSorted : $columnHeaderColorDefault;  
                     if ($byauthor) {  
                         print 'Author';  
                     } else {  
                         print &link('Author', sprintf('./%s#dirlist',  
                                                       &toggleQuery("sortby", "author")));  
                     }  
                     print "</th>";  
                 }  
                 $infocols++;  
                 printf '<th align=left bgcolor="%s">',  
                   $bylog ? $columnHeaderColorSorted : $columnHeaderColorDefault;  
                 if ($bylog) {  
                     print 'Last log entry';  
                 } else {  
                     print &link('Last log entry', sprintf('./%s#dirlist',  
                                                           &toggleQuery("sortby", "log")));  
                 }  
                 print "</th>";  
             }  
             elsif ($use_descriptions) {  
                 printf '<th align=left bgcolor="%s">', $columnHeaderColorDefault;  
                 print "Description";  
                 $infocols++;  
             }  
             print "</tr>\n";  
         }  
         else {  
             print "<menu>\n";  
         }  
         my $dirrow = 0;  
   
         my $i;    printf(<<EOF, $tablepadding, 'Directory index of ' . htmlquote($where));
         lookingforattic:  <table class="dir" width="100%%" cellspacing="0" cellpadding="%s" summary="%s">
         for ($i = 0; $i <= $#dir; $i++) {  <tr>
                 if ($dir[$i] eq "Attic") {  EOF
                     last lookingforattic;    printf('<th colspan="2"%s>', ($byfile ? ' class="sorted"' : ''));
                 }  
         }  
         if (!$input{'hideattic'} && ($i <= $#dir) &&  
             opendir($dh, $fullname . "/Attic")) {  
             splice(@dir, $i, 1,  
                         grep((s|^|Attic/|,!m|/\.|), readdir($dh)));  
             closedir($dh);  
         }  
   
         my $hideAtticToggleLink = $input{'hideattic'} ? '' :    if ($byfile) {
           &link('[Hide]', sprintf('./%s#dirlist',      print 'File';
                                   &toggleQuery ("hideattic")));    } else {
       print &link('File',
                   sprintf('./%s#dirlist', toggleQuery('sortby', 'file')));
     }
     print "</th>\n";
   
         # Sort without the Attic/ pathname.    # Do not display the other column headers if we do not have any files
         # place directories first    # with revision information.
     if (scalar(%fileinfo)) {
       $infocols++;
       printf('<th%s>', ($byrev ? ' class="sorted"' : ''));
   
         my $attic;      if ($byrev) {
         my $url;        print 'Rev.';
         my $fileurl;      } else {
         my $filesexists;        print &link('Rev.',
         my $filesfound;                    sprintf('./%s#dirlist', toggleQuery('sortby', 'rev')));
       }
       print "</th>\n";
       $infocols++;
       printf('<th%s>', ($bydate ? ' class="sorted"' : ''));
   
         foreach (sort { &fileSortCmp } @dir) {      if ($bydate) {
             if ($_ eq '.') {        print 'Age';
                 next;      } else {
             }        print &link('Age',
             # ignore CVS lock and stale NFS files                    sprintf('./%s#dirlist', toggleQuery('sortby', 'date')));
             next if (/^#cvs\.|^,|^\.nfs/);      }
       print "</th>\n";
   
             # Check whether to show the CVSROOT path      if ($show_author) {
             next if ($input{'hidecvsroot'} && ($_ eq 'CVSROOT'));        $infocols++;
         printf('<th%s>', ($byauthor ? ' class="sorted"' : ''));
   
             # Check whether the module is in the restricted list        if ($byauthor) {
             next if ($_ && &forbidden_module($_));          print 'Author';
         } else {
           print
             &link('Author',
                   sprintf('./%s#dirlist', toggleQuery('sortby', 'author')));
         }
         print "</th>\n";
       }
       $infocols++;
       printf('<th%s>', ($bylog ? ' class="sorted"' : ''));
   
             # Ignore non-readable files      if ($bylog) {
             next if ($input{'hidenonreadable'} && !(-r "$fullname/$_"));        print 'Last log entry';
       } else {
         print &link('Last log entry',
                     sprintf('./%s#dirlist', toggleQuery('sortby', 'log')));
       }
       print "</th>\n";
     } elsif ($use_descriptions) {
       print "<th>Description</th>\n";
       $infocols++;
     }
     print "</tr>\n";
   
             if (s|^Attic/||) {    my $dirrow = 0;
                 $attic  = " (in the Attic)&nbsp;" . $hideAtticToggleLink;  
             }  
             else {  
                 $attic = "";  
             }  
   
             if ($_ eq '..' || -d "$fullname/$_") {    my $i;
                 next if ($_ eq '..' && $where eq '/');    lookingforattic:
                 my ($rev,$date,$log,$author,$filename);    for ($i = 0; $i <= $#dir; $i++) {
                 ($rev,$date,$log,$author,$filename) = @{$fileinfo{$_}}      if ($dir[$i] eq "Attic") {
                     if (defined($fileinfo{$_}));        last lookingforattic;
                 printf '<tr bgcolor="%s"><td>', $tabcolors[$dirrow % 2] if $dirtable;      }
                 if ($_ eq '..') {    }
                     $url = "../$query";  
                     if ($nofilelinks) {  
                         print $backicon;  
                     }  
                     else {  
                         print &link($backicon, $url);  
                     }  
                     print " ", &link("Parent Directory", $url);  
                 }  
                 else {  
                     $url = './' . urlencode($_) . "/$query";  
                     print "<A NAME=\"$_\"></A>";  
                     if ($nofilelinks) {  
                         print $diricon;  
                     }  
                     else {  
                         print &link($diricon, $url);  
                     }  
                     print " ", &link("$_/", $url), $attic;  
                     if ($_ eq "Attic") {  
                         print "&nbsp; ";  
                         print &link("[Don't hide]", sprintf('./%s#dirlist',  
                                                             &toggleQuery ("hideattic")));  
                     }  
                 }  
                 # Show last change in dir  
                 if ($filename) {  
                     print "</td><td>&nbsp;</td><td>&nbsp;" if ($dirtable);  
                     if ($date) {  
                         print " <i>", readableTime(time() - $date,0), "</i>";  
                     }  
                     if ($show_author) {  
                         print "</td><td>&nbsp;" if ($dirtable);  
                         print $author;  
                     }  
                     print "</td><td>&nbsp;" if ($dirtable);  
                     $filename =~ s%^[^/]+/%%;  
                     print "$filename/$rev";  
                     print "<BR>" if ($dirtable);  
                     if ($log) {  
                         print "&nbsp;<font size=-1>",  
                           &htmlify(substr($log,0,$shortLogLen));  
                         if (length $log > 80) {  
                             print "...";  
                         }  
                         print "</font>";  
                     }  
                 }  
                 else {  
                     my ($dwhere) = ($where ne "/" ? $where : "") . $_;  
                     if ($use_descriptions && defined $descriptions{$dwhere}) {  
                         print "<TD COLSPAN=", ($infocols-1), ">&nbsp;" if $dirtable;  
                         print $descriptions{$dwhere};  
                     } elsif ($dirtable && $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 "</td><td>&nbsp;";  
                             $cols--;  
                         }  
                     }  
                 }  
                 if ($dirtable) {  
                     print "</td></tr>\n";  
                 }  
                 else {  
                     print "<br>\n";  
                 }  
                 $dirrow++;  
             }  
             elsif (s/,v$//) {  
                 $fileurl = ($attic ? "Attic/" : "") . urlencode($_);  
                 $url = './' . $fileurl . $query;  
                 my $rev = '';  
                 my $date = '';  
                 my $log = '';  
                 my $author = '';  
                 $filesexists++;  
                 next if (!defined($fileinfo{$_}));  
                 ($rev,$date,$log,$author) = @{$fileinfo{$_}};  
                 $filesfound++;  
                 printf '<tr bgcolor="%s"><td>', $tabcolors[$dirrow % 2] if $dirtable;  
                 print "<A NAME=\"$_\"></A>";  
                 if ($nofilelinks) {  
                     print $fileicon;  
                 }  
                 else {  
                     print &link($fileicon,$url);  
                 }  
                 print " ", &link($_, $url), $attic;  
                 print "</td><td>&nbsp;" if ($dirtable);  
                 download_link($fileurl,  
                               $rev, $rev,  
                               $defaultViewable ? "text/x-cvsweb-markup" : undef);  
                 print "</td><td>&nbsp;" if ($dirtable);  
                 if ($date) {  
                     print " <i>", readableTime(time() - $date,0), "</i>";  
                 }  
                 if ($show_author) {  
                     print "</td><td>&nbsp;" if ($dirtable);  
                     print $author;  
                 }  
                 print "</td><td>&nbsp;" if ($dirtable);  
                 if ($log) {  
                     print " <font size=-1>", &htmlify(substr($log,0,$shortLogLen));  
                     if (length $log > 80) {  
                         print "...";  
                     }  
                     print "</font>";  
                 }  
                 print "</td>" if ($dirtable);  
                 print (($dirtable) ? "</tr>" : "<br>");  
                 $dirrow++;  
             }  
             print "\n";  
         }  
         if ($dirtable && defined($tableBorderColor)) {  
             print "</td></tr></table>";  
         }  
         print( $dirtable == 1 ? "</table>\n" : "</menu>\n" );  
   
         if ($filesexists && !$filesfound) {    if (!$input{hideattic}
             print "<P><B>NOTE:</B> There are $filesexists files, but none matches the current tag ($input{only_with_tag})\n";        && ($i <= $#dir)
         }        && opendir($dh, $fullname . '/Attic'))
         if ($input{only_with_tag} && (!%tags || !$tags{$input{only_with_tag}})) {    {
             %tags = %alltags      splice(@dir, $i, 1, grep((s|^|Attic/|, !m|/\.|), readdir($dh)));
         }      closedir($dh);
         if (scalar %tags    }
             || $input{only_with_tag}  
             || $edit_option_form  
             || defined($input{"options"})) {  
             print "<hr size=1 NOSHADE>";  
         }  
   
         if (scalar %tags || $input{only_with_tag}) {    my $hideAtticToggleLink =
             print "<FORM METHOD=\"GET\" ACTION=\"./\">\n";      $input{hideattic}
             foreach my $var (@stickyvars) {      ? ''
                 print "<INPUT TYPE=HIDDEN NAME=\"$var\" VALUE=\"$input{$var}\">\n"      : &link('[hide]', sprintf('./%s#dirlist', &toggleQuery('hideattic')));
                     if (defined($input{$var})  
                         && (!defined($DEFAULTVALUE{$var})  
                             || $input{$var} ne $DEFAULTVALUE{$var})  
                         && $input{$var} ne ""  
                         && $var ne "only_with_tag");  
             }  
             print "Show only files with tag:\n";  
             print "<SELECT NAME=only_with_tag";  
             print " onchange=\"submit()\"" if ($use_java_script);  
             print ">";  
             print "<OPTION VALUE=\"\">All tags / default branch\n";  
             foreach my $tag (reverse sort { lc $a cmp lc $b } keys %tags) {  
                 print "<OPTION",defined($input{only_with_tag}) &&  
                        $input{only_with_tag} eq $tag ? " SELECTED" : "",  
                        ">$tag\n";  
             }  
             print "</SELECT>\n";  
             print " Module path or alias:\n";  
             printf "<INPUT TYPE=TEXT NAME=\"path\" VALUE=\"%s\" SIZE=15>\n", htmlquote($where);  
             print "<INPUT TYPE=SUBMIT VALUE=\"Go\">\n";  
             print "</FORM>\n";  
         }  
   
         if ($allow_tar) {    # Sort without the Attic/ pathname.
             my($basefile) = ($where =~ m,(?:.*/)?([^/]+),);    # place directories first
   
             if (defined($basefile) && $basefile ne '') {    my $filesexists;
                 print "<HR NOSHADE>\n",    my $filesfound;
                   "<DIV align=center>Download this directory in ";  
                 # 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 "</DIV>";  
             }  
         }  
   
         my $formwhere = $scriptwhere;    foreach my $file (sort { &fileSortCmp } @dir) {
         $formwhere =~ s|Attic/?$|| if ($input{'hideattic'});  
   
         if ($edit_option_form || defined($input{"options"})) {      next if ($file eq curdir());
             print "<FORM METHOD=\"GET\" ACTION=\"${formwhere}\">\n";  
             print "<INPUT TYPE=HIDDEN NAME=\"copt\" VALUE=\"1\">\n";      # ignore CVS lock and stale NFS files
             if ($cvstree ne $cvstreedefault) {      next if ($file =~ /^\#cvs\.|^,|^\.nfs/); # \# for XEmacs cperl-mode...
                 print "<INPUT TYPE=HIDDEN NAME=\"cvsroot\" VALUE=\"$cvstree\">\n";  
             }      # Check whether to show the CVSROOT path
             print "<center><table cellpadding=0 cellspacing=0>";      next if ($input{hidecvsroot} && $where eq '/' && $file eq 'CVSROOT');
             print "<tr bgcolor=\"$columnHeaderColorDefault\"><th colspan=2>Preferences</th></tr>";  
             print "<tr><td>Sort files by <SELECT name=\"sortby\">";      # Is it a directory?
             print "<OPTION VALUE=\"\">File";      my $isdir = -d catdir($fullname, $file);
             print "<OPTION",$bydate ? " SELECTED" : ""," VALUE=date>Age";  
             print "<OPTION",$byauthor ? " SELECTED" : ""," VALUE=author>Author"      # Ignore non-readable files and directories?
                 if ($show_author);      next if ($input{hidenonreadable} && (! -r _ || ($isdir && ! -x _)));
             print "<OPTION",$byrev ? " SELECTED" : ""," VALUE=rev>Revision";  
             print "<OPTION",$bylog ? " SELECTED" : ""," VALUE=log>Log message";      my $attic = '';
             print "</SELECT></td>";      if ($file =~ s|^Attic/||) {
             print "<td>Sort log by: ";        $attic = ' <span class="attic">(in the Attic) ' .
             printLogSortSelect(0);          $hideAtticToggleLink . '</span>';
             print "</td></tr>";  
             print "<tr><td>Diff format: ";  
             printDiffSelect(0);  
             print "</td>";  
             print "<td>Show Attic files: ";  
             print "<INPUT NAME=hideattic TYPE=CHECKBOX", $input{'hideattic'} ? " CHECKED" : "",  
             "></td></tr>\n";  
             print "<tr><td align=center colspan=2><input type=submit value=\"Change Options\">";  
             print "</td></tr></table></center></FORM>\n";  
         }  
         print &html_footer;  
         print "</BODY></HTML>\n";  
     }      }
   
       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 "<tr class=\"%s\">\n<td class=\"dir\" colspan=\"2\">",
           ($dirrow % 2) ? 'even' : 'odd';
   
         if ($file eq updir()) {
           my $url = "../$query";
           print $nofilelinks ? $backicon : &link($backicon, $url);
           print '&nbsp;', &link("Parent Directory", $url);
   
         } else {
           my $url = './' . uri_escape_path($file) . "/$query";
           print '<a name="', htmlquote($file), '"></a>';
           print $nofilelinks ? $diricon : &link($diricon, $url);
           print '&nbsp;', &link(htmlquote("$file/"), $url), $attic;
           if ($file eq "Attic") {
             print ' <span class="attic">',
               &link('[show]',
                     sprintf('./%s#dirlist', &toggleQuery('hideattic'))),
                       '</span>';
           }
         }
   
         # Show last change in dir
         if ($filename) {
           my $ageclass = 'age';
           my $age      = '';
           if ($date) {
             $age       = readableTime(time() - $date, 0);
             $ageclass .= " $1" if ($age =~ /^\d+ ([a-z]+)/);
           }
           print "</td>\n<td>&nbsp;</td>\n<td class=\"$ageclass\">$age";
           print "</td>\n<td class=\"author\">", htmlquote($author)
             if $show_author;
           print "</td>\n<td class=\"log\">";
           $filename =~ s%^[^/]+/%%;
           print &link(htmlquote("$filename/$rev"),
                       sprintf('%s/%s%s#rev%s',
                               uri_escape($file), uri_escape($filename),
                               $query, $rev)), '<br />';
           if ($log) {
             print htmlify(substr($log, 0, $shortLogLen), $allow_dir_extra);
             print '...' if (length($log) > 80);
           }
   
         } else {
           my $dwhere = ($where ne '/' ? $where : '') . $file;
   
           if ($use_descriptions && defined $descriptions{$dwhere}) {
             print '<td colspan="', ($infocols - 1), '">';
             print $descriptions{$dwhere};
   
           } elsif ($infocols > 1) {
   
             # close the row with the appropriate number of
             # columns, so that the vertical seperators are visible
             my ($cols) = $infocols;
             while ($cols > 1) {
               print "</td>\n<td>&nbsp;";
               $cols--;
             }
           }
         }
   
         print "</td>\n</tr>\n";
         $dirrow++;
   
       } elsif ($file =~ s/,v$//) {
   
         my $fileurl = ($attic ? 'Attic/' : '') . uri_escape_path($file);
         my $url     = './' . $fileurl . $query;
         $filesexists++;
         next if (!defined($fileinfo{$file}));
         my ($rev, $date, $log, $author, $filename, $keywordsubst) =
           @{$fileinfo{$file}};
         my $isbinary = $keywordsubst eq 'b' ? 1 : 0;
         $filesfound++;
   
         printf "<tr class=\"%s\">\n", ($dirrow % 2) ? 'even' : 'odd';
         printf '<td class="file" colspan="2">';
   
         my $icon = $isbinary ? $binfileicon : $fileicon;
         print $nofilelinks ? $icon : &link($icon, $url);
         print '&nbsp;', &link(htmlquote($file), $url), $attic;
         print "</td>\n<td width=\"30\">", display_link($fileurl, $rev);
         my $ageclass = 'age';
         my $age      = '';
         if ($date) {
           $age       = readableTime(time() - $date, 0);
           $ageclass .= " $1" if ($age =~ /^\d+ ([a-z]+)/);
         }
         print "</td>\n<td class=\"$ageclass\">$age";
         print "</td>\n<td class=\"author\">", htmlquote($author) if $show_author;
         print "</td>\n<td class=\"log\">";
   
         if ($log) {
           print htmlify(substr($log, 0, $shortLogLen), $allow_dir_extra);
           print '...' if (length $log > 80);
         }
         print "</td>\n</tr>";
         $dirrow++;
       }
       print "\n";
     }
   
     print "</table>\n";
   
     if ((my $num = scalar(@unreadable)) && ! $input{hidenonreadable}) {
       printf(<<EOF, $num, htmlquote(join(', ', @unreadable)));
   <p>
    <b>NOTE:</b> The following %d unreadable files were ignored:<br />
    <em>%s</em>
   </p>
   EOF
     }
   
     if ($filesexists && !$filesfound) {
       my $currtag = defined($input{only_with_tag}) ?
         sprintf(' (%s)', htmlquote($input{only_with_tag})) : '';
       printf(<<EOF, $filesexists, $currtag);
   <p>
    <b>NOTE:</b> There are %d files, but none matches the current tag%s.
   </p>
   EOF
     }
   
     if ($input{only_with_tag} && (!%tags || !$tags{$input{only_with_tag}})) {
       %tags = %alltags;
     }
   
     if (scalar %tags
         || $input{only_with_tag}
         || $edit_option_form
         || defined($input{options}))
     {
       print "<hr />\n";
     }
   
     if (scalar %tags || $input{only_with_tag}) {
       print "<form method=\"get\" action=\"./\">\n<p>\n";
       foreach my $var (@stickyvars) {
         printf("<input type=\"hidden\" name=\"%s\" value=\"%s\" />\n",
                $var, htmlquote($input{$var}))
           if (defined($input{$var})
               && (!defined($DEFAULTVALUE{$var})
                   || $input{$var} ne $DEFAULTVALUE{$var})
               && $var ne 'only_with_tag');
       }
       print <<EOF;
   <span class="nowrap">
   <label for="only_with_tag" accesskey="T">Show only files with tag:
   <select id="only_with_tag" name="only_with_tag">
   <option value="">All tags / default branch</option>
   EOF
       foreach my $tag (reverse sort { lc $a cmp lc $b } keys %tags) {
         my $selected =
           defined($input{only_with_tag}) && $input{only_with_tag} eq $tag;
         printf("<option%s>%s</option>\n",
                $selected ? ' selected="selected"' : '',
                htmlquote($tag));
       }
       printf(<<EOF, htmlquote($where));
   </select>
   </label></span> <span class="nowrap">
   <label for="path" accesskey="P">Module path or alias:
   <input type="text" id="path" name="path" value="%s" size="15" /></label>
   </span>
   <input type="submit" value="Go" accesskey="G" />
   </p>
   </form>
   EOF
     }
   
     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 "<hr />\n",
           '<div style="text-align: center">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), "</div>\n";
       }
     }
   
     if ($edit_option_form || defined($input{options})) {
   
       print <<EOF;
   <form method="get" action="./">
   <fieldset>
   <legend>General options</legend>
   <input type="hidden" name="copt" value="1" />
   EOF
       for my $v (qw(hidecvsroot hidenonreadable)) {
         printf(qq{<input type="hidden" name="%s" value="%s" />\n},
                $v, $input{$v} || 0);
       }
       if ($cvstree ne $cvstreedefault) {
         print "<input type=\"hidden\" name=\"cvsroot\" value=\"$cvstree\" />\n";
       }
       print <<EOF;
   <table summary="General options">
   <tr>
   <td class="opt-label">
   <label for="sortby" accesskey="F">Sort files by:</label>
   </td>
   <td class="opt-value">
   <select id="sortby" name="sortby">
   <option value="">File</option>
   EOF
       print "<option", $bydate ? ' selected="selected"' : '',
         " value=\"date\">Age</option>\n";
       print "<option", $byauthor ? ' selected="selected"' : '',
         " value=\"author\">Author</option>\n"
           if $show_author;
       print "<option", $byrev ? ' selected="selected"' : '',
         " value=\"rev\">Revision</option>\n";
       print "<option", $bylog ? ' selected="selected"' : '',
         " value=\"log\">Log message</option>\n";
       print <<EOF;
   </select>,
   <label for="ignorecase" accesskey="I">case-insensitive:
   EOF
       print '<input id="ignorecase" name="ignorecase" type="checkbox"',
         $input{ignorecase} ? ' checked="checked"' : '',
           " value=\"1\" /></label>\n";
       print <<EOF;
   </td>
   <td class="opt-label">
   <label for="hideattic" accesskey="A">Hide files in Attic:</label>
   </td>
   <td class="opt-value">
   EOF
       print '<input id="hideattic" name="hideattic" type="checkbox"',
         $input{hideattic} ? ' checked="checked"' : '', ' value="1" />';
       print <<EOF;
   </td>
   </tr>
   <tr>
   <td class="opt-label">
   <label for="logsort" accesskey="L">Sort log by:</label>
   </td>
   <td class="opt-value">
   EOF
       printLogSortSelect();
       print <<EOF;
   </td>
   <td class="opt-label">
   <label for="ln" accesskey="N">Show line numbers:</label>
   </td>
   <td class="opt-value">
   EOF
       print '<input id="ln" name="ln" type="checkbox"',
         $input{ln} ? ' checked="checked"' : '', " value=\"1\" />\n";
       print <<EOF;
   </td>
   </tr>
   <tr>
   <td class="opt-label">
   <label for="f" accesskey="D">Diff format:</label>
   </td>
   <td>
   EOF
       printDiffSelect();
       print <<EOF;
   </td>
   <td colspan="2" class="opt-label">
   <input type="submit" value="Change Options" accesskey="C" />
   </td>
   </tr>
   </table>
   </fieldset>
   </form>
   EOF
     }
     html_footer();
   }
   
 ###############################  ###############################
 # View Files  # View Files
 ###############################  ###############################
     elsif (-f $fullname . ',v') {  elsif (-f $fullname . ',v') {
         if (defined($input{'rev'}) || $doCheckout) {  
             &doCheckout($fullname, $input{'rev'});    if (defined($input{rev}) || $doCheckout) {
             gzipclose();      &doCheckout($fullname, $input{rev}, $input{only_with_tag});
             exit;      gzipclose();
         }      exit;
         if (defined($input{'annotate'}) && $allow_annotate) {    }
             &doAnnotate($input{'annotate'});  
             gzipclose();    if (defined($input{annotate}) && $allow_annotate) {
             exit;      &doAnnotate($input{annotate}, $input{only_with_tag});
         }      gzipclose();
         if (defined($input{'r1'}) && defined($input{'r2'})) {      exit;
             &doDiff($fullname, $input{'r1'}, $input{'tr1'},    }
                     $input{'r2'}, $input{'tr2'}, $input{'f'});  
             gzipclose();    if (defined($input{r1}) && defined($input{r2})) {
             exit;      &doDiff($fullname,  $input{r1},  $input{tr1},
         }              $input{r2}, $input{tr2}, $input{f});
         print("going to dolog($fullname)\n") if ($verbose);      gzipclose();
         &doLog($fullname);      exit;
     }
   
     &doLog($fullname);
   }
   
 ##############################  ##############################
 # View Diff  # View Diff
 ##############################  ##############################
     }  elsif ($fullname =~ s/\.diff$//
     elsif ($fullname =~ s/\.diff$// && -f $fullname . ",v" &&         && -f $fullname . ',v' && $input{r1} && $input{r2})
            $input{'r1'} && $input{'r2'}) {  {
   
         # $where-diff-removal if 'cvs rdiff' is used    # $where-diff-removal if 'cvs rdiff' is used
         # .. but 'cvs rdiff'doesn't support some options    # .. but 'cvs rdiff'doesn't support some options
         # rcsdiff does (-w and -p), so it is disabled    # rcsdiff does (-w and -p), so it is disabled
         # $where =~ s/\.diff$//;    # $where =~ s/\.diff$//;
   
         # Allow diffs using the ".diff" extension    # Allow diffs using the ".diff" extension so that browsers that default
         # so that browsers that default to the URL    # to the filename in the URL when saving don't save diffs as eg. foo.c.
         # for a save filename don't save diff's as    &doDiff($fullname,  $input{r1},  $input{tr1},
         # e.g. foo.c            $input{r2}, $input{tr2}, $input{f});
         &doDiff($fullname, $input{'r1'}, $input{'tr1'},    gzipclose();
                 $input{'r2'}, $input{'tr2'}, $input{'f'});    exit;
         gzipclose();  
         exit;  }
   
   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;
   
   }
   
   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");
         }
     }      }
     elsif (($newname = $fullname) =~ s|/([^/]+)$|/Attic/$1| &&      close($fh);
            -f $newname . ",v") {    }
         # The file has been removed and is in the Attic.    fatal("404 Not Found", '%s: no such file or directory', $where);
         # Send a redirect pointing to the file in the Attic.  }
         (my $newplace = $scriptwhere) =~ s|/([^/]+)$|/Attic/$1|;  
         redirect("$newplace$query");  
         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);  
         # 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","$where: no such file or directory");  
     }  
   
 gzipclose();  gzipclose();
   
 ## End MAIN  ## End MAIN
   
 sub printDiffSelect($) {  
     my ($use_java_script) = @_;  
     my $f = $input{'f'};  
   
     print '<SELECT NAME="f"';  sub printDiffSelect()
     print ' onchange="submit()"' if $use_java_script;  {
     print '>';    print '<select id="f" name="f"';
     print ">\n";
   
     local $_;    for my $difftype (@DIFFTYPES) {
     for (@DIFFTYPES) {      printf("<option value=\"%s\"%s>%s</option>\n",
         printf('<OPTION VALUE="%s"%s>%s',             $difftype, $input{f} eq $difftype ? ' selected="selected"' : '',
                $_,             "\u$DIFFTYPES{$difftype}{descr}");
                $f eq $_ ? ' SELECTED' : '',    }
                "\u$DIFFTYPES{$_}{'descr'}"  
               );  
     }  
   
     print "</SELECT>";    print "</select>";
 }  }
   
 sub printLogSortSelect($) {  
     my ($use_java_script) = @_;  
   
     print '<SELECT NAME="logsort"';  sub printDiffSelectStickyVars()
     print ' onchange="submit()"' if $use_java_script;  {
     print '>';    while (my ($key, $val) = each %input) {
       next if ($key eq 'f');
       next if (defined($DEFAULTVALUE{$key}) && $DEFAULTVALUE{$key} eq $val);
       print "<input type=\"hidden\" name=\"", htmlquote($key), "\" value=\"",
         htmlquote($val), "\" />\n";
     }
   }
   
     local $_;  
     for (@LOGSORTKEYS) {  
         printf('<OPTION VALUE="%s"%s>%s',  
                $_,  
                $logsort eq $_ ? ' SELECTED' : '',  
                "\u$LOGSORTKEYS{$_}{'descr'}"  
               );  
     }  
   
     print "</SELECT>";  sub printLogSortSelect()
   {
     print '<select id="logsort" name="logsort"';
     print ">\n";
   
     for my $sortkey (@LOGSORTKEYS) {
       printf("<option value=\"%s\"%s>%s</option>\n",
              $sortkey, $logsort eq $sortkey ? ' selected="selected"' : '',
              "\u$LOGSORTKEYS{$sortkey}{descr}");
     }
   
     print "</select>";
 }  }
   
 sub findLastModifiedSubdirs(@) {  
     my (@dirs) = @_;  
     my ($dirname, @files);  
   
     foreach $dirname (@dirs) {  #
         next if ($dirname eq ".");  # Find the last modified, version controlled files in the given directories.
         next if ($dirname eq "..");  # Compares solely based on modification timestamps.  Files in the returned list
         my ($dir) = "$fullname/$dirname";  # are without the ,v suffix, and unreadable files have been filtered out.
         next if (!-d $dir);  #
   sub findLastModifiedSubdirs(@)
   {
     my (@dirs) = @_;
   
         my ($lastmod) = undef;    my @files;
         my ($lastmodtime) = undef;    foreach my $dirname (@dirs) {
         my $dh = do {local(*DH);};      next if ($dirname eq curdir() || $dirname eq updir());
       my $dir = catdir($fullname, $dirname);
       next if (!-d $dir);
   
         opendir($dh,$dir) || next;      my $dh = do { local (*DH); };
         my (@filenames) = readdir($dh);      opendir($dh, $dir) or next;
         closedir($dh);      my (@filenames) = grep(!forbidden(catfile($dir, $_)), readdir($dh));
       closedir($dh);
   
         foreach my $filename (@filenames) {      my $lastmod     = undef;
             $filename = "$dirname/$filename";      my $lastmodtime = undef;
             my ($file) = "$fullname/$filename";      foreach my $filename (@filenames) {
             next if ($filename !~ /,v$/ || !-f $file);        ($filename) =
             $filename =~ s/,v$//;          (catfile($dirname, $filename) =~ VALID_PATH) or next; # untaint
             my $modtime = -M $file;        my ($file) = catfile($fullname, $filename);
             if (!defined($lastmod) || $modtime < $lastmodtime) {        next if ($filename !~ /,v$/o || !-f $file || !-r _);
                 $lastmod = $filename;        my $modtime = -M _;
                 $lastmodtime = $modtime;        if (!defined($lastmod) || $modtime < $lastmodtime) {
             }          ($lastmod    = $filename) =~ s/,v$//;
         }          $lastmodtime = $modtime;
         push(@files, $lastmod) if (defined($lastmod));        }
     }      }
     return @files;      push(@files, $lastmod) if (defined($lastmod));
     }
     return @files;
 }  }
   
 sub htmlify_sub(&$) {  
     (my $proc, local $_) = @_;  
     my @a = split(m`(<a [^>]+>[^<]*</a>)`i);  
     my $linked;  
     my $result = '';  
   
     while (($_, $linked) = splice(@a, 0, 2)) {  sub htmlify_sub(&$)
         &$proc();  {
         $result .= $_ if defined($_);    (my $proc, local $_) = @_;
         $result .= $linked if defined($linked);    my @a = split(m|(<a [^>]+>[^<]*</a>)|i);
     }    my $linked;
     my $result = '';
   
     $result;    while (($_, $linked) = splice(@a, 0, 2)) {
       &$proc();
       $result .= $_      if defined($_);
       $result .= $linked if defined($linked);
     }
   
     return $result;
 }  }
   
 sub htmlify($;$) {  
     (local $_, my $extra) = @_;  
   
     $_ = htmlquote($_);  sub htmlify($;$)
   {
     (local $_, my $extra) = @_;
   
     # get URL's as link    $_ = htmlquote($_);
     s{  
       (http|ftp|https)://\S+  
      }{  
          &link($&, htmlunquote($&))  
      }egx;  
   
     # get e-mails as link    # get URL's as link
     s{
       ((https?|ftp)://.+?)([\s\']|&(quot|[lg]t);)
      }{
        &link($1, htmlunquote($1)) . $3
      }egx;
   
     if ($allow_mailtos) {
       # Make mailto: links from email addresses.
     $_ = htmlify_sub {      $_ = htmlify_sub {
         s<        s<
           [\w+=\-.!]+@[\w\-]+(\.[\w\-]+)+          ([\w+=\-.!]+@[\w\-]+(?:\.[\w\-]+)+)
             ><         ><
               &link($&, "mailto:$&")           &link($1, "mailto:$1")
                 >egix;         >egix;
     } $_;      } $_;
     }
   
     if ($extra) {    if ($extra) {
         # get PR #'s as link: "PR#nnnn" "PR: nnnn, ..." "PR nnnn, ..." "bin/nnnn"  
         if (defined($prcgi) && defined($re_prcategories) && defined($re_prkeyword)) {  
             my $prev;  
   
             do {      # get PR #'s as link: "PR#nnnn" "PR: nnnn, ..." "PR nnnn, ..." "bin/nnnn"
                 $prev = $_;      if (defined($prcgi) && defined($re_prkeyword)) {
         my $prev;
   
                 $_ = htmlify_sub {        do {
                     s{          $prev = $_;
                       (\b$re_prkeyword[:\#]?\s*          $_ = htmlify_sub {
                        (?:            s{
                         \#?              (\b$re_prkeyword[:\#]?\s*
                         \d+[,\s]\s*               (?:
                        )*                \#?
                        \#?)                \d+[,\s]\s*
                       (\d+)\b               )*
                      }{               \#?)
                          $1 . &link($2, sprintf($prcgi, $2))              (\d+)\b
                      }egix;             }{
                 } $_;               $1 . &link($2, sprintf($prcgi, $2))
             } while ($_ ne $prev);             }egix;
           } $_;
         } while ($_ ne $prev);
   
             $_ = htmlify_sub {        if (defined($re_prcategories)) {
                 s{          $_ = htmlify_sub {
                   (\b$re_prcategories/(\d+)\b)            s{
                  }{              (\b$re_prcategories/(\d+)\b)
                      &link($1, sprintf($prcgi, $2))             }{
                  }egox;               &link($1, sprintf($prcgi, $2))
             } $_;             }egox;
         }          } $_;
         }
       }
   
         # get manpage specs as link: "foo.1" "foo(1)"      # get manpage specs as link: "foo.1" "foo(1)"
         if (defined($mancgi)) {      if (defined($mancgi)) {
             $_ = htmlify_sub {        $_ = htmlify_sub {
                 s{          s{
                   (\b([a-zA-Z][\w.]+)            (
                    (?:             \b ( \w[\w+\-.]* (?: ::\w[\w+\-.]*)* )
                     \( ([0-9n]) \)\B             (?:
                     |              \( ([0-9n]) \) \B
                     \.([0-9n])\b              |
                    )              \. ([0-9n]) \b
                   )             )
                  }{            )
                      &link($1, sprintf($mancgi, defined($3) ? $3 : $4, $2))           }{
                  }egx;              my($text, $name, $section) = ($1, $2, defined($3) ? $3 : $4);
             } $_;              ($name =~ /[A-Za-z]/ && $name !~ /\.(:|$)/)
         }               ? &link($text, sprintf($mancgi, uri_escape($name), $section))
                 : $text;
            }egx;
         } $_;
     }      }
     }
   
     $_;    return $_;
 }  }
   
 sub spacedHtmlText($;$) {  
         local $_ = $_[0];  
         my $ts = $_[1] || $tabstop;  
   
         # Cut trailing spaces and tabs  sub spacedHtmlText($;$)
         s/[ \t]+$//;  {
     (local $_, my $ts) = @_;
     return '' unless defined($_);
     $ts ||= $tabstop || 8;
   
         if (defined($ts)) {    # Expand tabs
             # Expand tabs    1 while s/(.*?)(\t+)/$1 . ' ' x (length($2) * $ts - length($1) % $ts)/e;
             1 while s/\t+/' ' x (length($&) * $ts - length($`) % $ts)/e  
         }  
   
         # replace <tab> and <space> (\001 is to protect us from htmlify)    if ($hr_breakable) {
         # gzip can make excellent use of this repeating pattern :-)      s/^ /\001nbsp;/;      # protect leading and...
         if ($hr_breakable) {      s/ $/\001nbsp;/;      # ...trailing whitespace (mostly for String::Ediff),
             # make every other space 'breakable'      s/  / \001nbsp;/g;    # ...and leave every other space 'breakable'
             s/  / \001nbsp;/g;                              # 2 * <space>    } else {
             # leave single space as it is      s/ /\001nbsp;/g;
         } else {    }
             s/ /\001nbsp;/g;  
         }  
   
         $_ = htmlify($_);    $_ = htmlify($_, $allow_source_extra);
   
         # unescape    # unescape
         y/\001/&/;    y/\001/&/;
   
         return $_;    return $_;
 }  }
   
 sub link($$) {  
         my($name, $url) = @_;  
   
         $url =~ s/:/sprintf("%%%02x", ord($&))/eg if $url =~ /^[^a-z]/; # relative  # Note that this doesn't htmlquote the first argument...
   sub link($$)
         sprintf '<A HREF="%s">%s</A>', hrefquote($url), $name;  {
     my ($name, $url) = @_;
     return sprintf('<a href="%s">%s</a>', htmlquote($url), $name);
 }  }
   
 sub revcmp($$) {  
         my($rev1, $rev2) = @_;  
   
         # make no comparison for a tag or a branch  sub revcmp($$)
         return 0 if $rev1 =~ /[^\d.]/ || $rev2 =~ /[^\d.]/;  {
     my ($rev1, $rev2) = @_;
   
         my(@r1) = split(/\./, $rev1);    # make no comparison for a tag or a branch
         my(@r2) = split(/\./, $rev2);    return 0 if $rev1 =~ /[^\d.]/ || $rev2 =~ /[^\d.]/;
         my($a,$b);  
   
         while (($a = shift(@r1)) && ($b = shift(@r2))) {    my (@r1) = split(/\./, $rev1);
             if ($a != $b) {    my (@r2) = split(/\./, $rev2);
                 return $a <=> $b;    my ($a, $b);
             }  
         }  
         if (@r1) { return 1; }  
         if (@r2) { return -1; }  
         return 0;  
 }  
   
 sub fatal($$) {    while (($a = shift(@r1)) && ($b = shift(@r2))) {
         my($errcode, $errmsg) = @_;      return $a <=> $b unless ($a == $b);
         if ($is_mod_perl) {    }
                 Apache->request->status((split(/ /, $errcode))[0]);    if (@r1) { return  1; }
         }    if (@r2) { return -1; }
         else {    return 0;
                 print "Status: $errcode\r\n";  
         }  
         html_header("Error");  
         print "Error: $errmsg\n";  
         print &html_footer;  
         exit(1);  
 }  }
   
 sub redirect($) {  
         my($url) = @_;  #
         if ($is_mod_perl) {  # Signal a fatal error.
                 Apache->request->status(301);  #
                 Apache->request->header_out(Location => $url);  sub fatal($$@)
         }  {
         else {    my ($errcode, $format, @args) = @_;
                 print "Status: 301 Moved\r\n";    print "Status: $errcode\r\n";
                 print "Location: $url\r\n";    html_header('Error');
         }    print '<div id="error">Error: ',
         html_header("Moved");      sprintf($format, map(htmlquote($_), @args)), "</div>\n";
         print "This document is located ", &link('here', $url), "\n";    html_footer();
         print &html_footer;    exit(1);
         exit(1);  
 }  }
   
 sub safeglob($) {  
         my ($filename) = @_;  
         my ($dirname);  
         my (@results);  
         my $dh = do {local(*DH);};  
   
         ($dirname = $filename) =~ s|/[^/]+$||;  #
         $filename =~ s|.*/||;  # Signal a (fatal) configuration error.
   #
   sub config_error($$)
   {
     fatal('500 Internal Error',
           'Error loading configuration file "<code>%s</code>":<br /><br />' .
           '%s<br />', @_);
   }
   
         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 "<p>This document has moved ", &link('here', $url), ".</p>\n";
     html_footer();
     exit(1);
 }  }
   
 sub search_path($) {  
     my($command) = @_;  
     my $d;  
   
     for $d (split(/:/, $command_path)) {  sub safeglob($)
         return "$d/$command" if -x "$d/$command";  {
     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};  # Searches @command_path for the given executable file.
     $mimetype = $MTYPES{'*'} if (!$mimetype);  #
   sub search_path($)
   {
     my ($command) = @_;
     for my $d (@command_path) {
       my $cmd = catfile($d, $command);
       return $cmd if (-x $cmd && !-d _);
     }
     return '';
   }
   
     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/)) {  # Gets the MIME type for the given file name.
         $mimetype = "text/plain";  #
   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: $!");
     }      }
     return $mimetype;    }
   
     $mimetype ||= $MTYPES{'*'};
     $mimetype ||= $binary ? 'application/octet-stream' : 'text/plain';
     return $mimetype;
 }  }
   
   
 ###############################  ###############################
 # read first lines like head(1)  # read first lines like head(1)
 ###############################  ###############################
 sub head($;$) {  sub head($;$)
     my $fh = $_[0];  {
     my $linecount = $_[1] || 10;    my ($fh, $linecount) = @_;
     $linecount ||= 10;
   
     my @buf;    my @buf;
     if ($linecount > 0) {
     if ($linecount > 0) {      for (my $i = 0; !eof($fh) && $i < $linecount; $i++) {
         my $i;        push @buf, scalar <$fh>;
         for ($i = 0; !eof($fh) && $i < $linecount; $i++) {  
             push @buf, scalar <$fh>;  
         }  
     } else {  
         @buf = <$fh>;  
     }      }
     } else {
     @buf;      @buf = <$fh>;
     }
     return @buf;
 }  }
   
   
 ###############################  ###############################
 # scan vim and Emacs directives  # scan vim and Emacs directives
 ###############################  ###############################
 sub scan_directives(@) {  sub scan_directives(@)
     my $ts = undef;  {
     my $ts = undef;
   
     for (@_) {    for (@_) {
         $ts = $1 if /\b(?:ts|tabstop|tab-width)[:=]\s*([1-9]\d*)\b/;      $ts = $1 if /\b(?:ts|tabstop|tab-width)[:=]\s*([1-9]\d*)\b/;
     }    }
   
     ('tabstop' => $ts);    ('tabstop' => $ts);
 }  }
   
   
   sub openOutputFilter()
   {
     return unless $output_filter;
   
     open(STDOUT, "|-") and return;
   
     # child of child
     open(STDERR, '>', devnull()) unless $DEBUG;
     exec($output_filter) or exit -1;
   }
   
   
 ###############################  ###############################
 # show Annotation  # show Annotation
 ###############################  ###############################
 sub doAnnotate($$) {  sub doAnnotate($$)
     my ($rev) = @_;  {
     my ($pid);    my ($rev, $tag) = @_;
     my ($pathname, $filename);    $rev = $tag || 'HEAD' if ($rev eq '.');
     my $reader = do {local(*FH);};    (my $pathname = $where) =~ s|((?<=/)Attic/)?[^/]*$||;
     my $writer = do {local(*FH);};    (my $filename = $where) =~ s|^.*/||;
   
     # make sure the revisions are wellformed, for security    # This annotate version is based on the cvs annotate-demo Perl script by
     # reasons ..    # Cyclic Software.  It was written by Cyclic Software,
     if ($rev =~ /[^\w.]/) {    # http://www.cyclic.com/, and is in the public domain.
         &fatal("404 Not Found",    # We could abandon the use of rlog, rcsdiff and co using
                 "Malformed query \"$ENV{QUERY_STRING}\"");    # the cvs server in a similiar way one day (..after rewrite).
     }  
   
     ($pathname = $where) =~ s/(Attic\/)?[^\/]*$//;    local (*CVS_IN, *CVS_OUT);
     ($filename = $where) =~ s/^.*\///;    my $annotate_err;
     my ($h, $err) =
       startproc([ $CMD{cvs}, @annotate_options, 'server' ],
                 '<pipe', \*CVS_IN, '>pipe', \*CVS_OUT,
                 '2>', \$annotate_err);
     fatal('500 Internal Error',
           'Annotate failure (exit status %s), output: <pre>%s</pre>',
           $? >> 8 || -1, $err)
       unless $h;
   
     # this seems to be necessary    # OK, first send the request to the server.  A simplified example is:
     $| = 1; $| = 0; # Flush    #     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.
   
     # this annotate version is based on the    print CVS_IN "Root $cvsroot\n";
     # cvs annotate-demo Perl script by Cyclic Software    print CVS_IN
     # It was written by Cyclic Software, http://www.cyclic.com/, and is in      "Valid-responses ok error Valid-requests Checked-in Updated Merged Removed M E\n";
     # 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}, @cvs_options, "server")  
       || fatal ("500 Internal Error", "Fatal Error - unable to open cvs for annotation");  
   
     # OK, first send the request to the server.  A simplified example is:    # Don't worry about sending valid-requests, the server just needs to
     #     Root /home/kingdon/zwork/cvsroot    # support "annotate" and if it doesn't, there isn't anything to be done.
     #     Argument foo/xx    print CVS_IN "UseUnchanged\n";
     #     Directory foo    print CVS_IN "Argument -r\n";
     #     /home/kingdon/zwork/cvsroot/foo    print CVS_IN "Argument $rev\n";
     #     Directory .    print CVS_IN "Argument $where\n";
     #     /home/kingdon/zwork/cvsroot  
     #     annotate  
     # although as you can see there are a few more details.  
   
     print $writer "Root $cvsroot\n";    # The protocol requires us to fully fake a working directory (at
     print $writer "Valid-responses ok error Valid-requests Checked-in Updated Merged Removed M E\n";    # least to the point of including the directories down to the one
     # Don't worry about sending valid-requests, the server just needs to    # containing the file in question).
     # support "annotate" and if it doesn't, there isn't anything to be done.    # So if $where is "dir/sdir/file", then dirs will be ("dir","sdir","file")
     print $writer "UseUnchanged\n";    my $path = '';
     print $writer "Argument -r\n";    foreach my $dir (split('/', $where)) {
     print $writer "Argument $rev\n";  
     print $writer "Argument $where\n";  
   
     # The protocol requires us to fully fake a working directory (at      if ($path eq "") {
     # least to the point of including the directories down to the one        # In our example, $dir is "dir".
     # containing the file in question).        $path = $dir;
     # So if $where is "dir/sdir/file", then @dirs will be ("dir","sdir","file")      } else {
     my @dirs = split('/', $where);        print CVS_IN "Directory $path\n";
     my $path = "";        print CVS_IN "$cvsroot/$path\n";
     foreach (@dirs) {  
         if ($path eq "") {        # In our example, $_ is "sdir" and $path becomes "dir/sdir"
             # In our example, $_ is "dir".        # And the next time, "file" and "dir/sdir/file" (which then gets
             $path = $_;        # ignored, because we don't need to send Directory for the file).
         }        $path .= "/$dir";
         else {  
             print $writer "Directory $path\n";  
             print $writer "$cvsroot/$path\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 .= "/$_";  
         }  
     }      }
     # And the last "Directory" before "annotate" is the top level.    }
     print $writer "Directory .\n";    undef $path;
     print $writer "$cvsroot\n";  
   
     print $writer "annotate\n";    # And the last "Directory" before "annotate" is the top level.
     # OK, we've sent our command to the server.  Thing to do is to    print CVS_IN "Directory .\n";
     # close the writer side and get all the responses.  If "cvs server"    print CVS_IN "$cvsroot\n";
     # were nicer about buffering, then we could just leave it open, I think.  
     close ($writer) || die "cannot close: $!";  
   
     http_header();    print CVS_IN "annotate\n";
   
     navigateHeader($scriptwhere,$pathname,$filename,$rev, "annotate");    # OK, we've sent our command to the server.  Thing to do is to
     print "<h3 align=center>Annotation of $pathname$filename, Revision $rev</h3>\n";    # close the writer side and get all the responses.
     if (!close(CVS_IN)) {
       $h->finish();
       fatal('500 Internal Error',
             'Annotate failure (exit status %s): <code>%s</code>, output: ' .
             '<pre>%s</pre>', $? >> 8, $!, $annotate_err);
     }
   
     # Ready to get the responses from the server.    navigateHeader($scriptwhere, $pathname, $filename, $rev, 'annotate');
     # 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);  
     if ($annTable) {  
         print "<table border=0 cellspacing=0 cellpadding=0>\n";  
     }  
     else {  
         print "<pre>";  
     }  
   
     # prefetch several lines    my $revtype = ($rev =~ /\./) ? 'revision' : 'tag'; # TODO: tag -> branch/tag?
     my @buf = head($reader);    print '<h3 style="text-align: center">Annotation of ',
       htmlquote("$pathname$filename"), ", $revtype $rev</h3>\n";
   
     my %d = scan_directives(@buf);    # 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);
   
     while (@buf || !eof($reader)) {    if ($annTable) {
         $_ = @buf ? shift @buf : <$reader>;      print <<EOF;
   <table style="border: none" cellspacing="0" cellpadding="0" summary="Annotation">
   EOF
     } else {
       print "<pre>";
     }
   
         my @words = split;    # prefetch several lines
         # Adding one is for the (single) space which follows $words[0].    my @buf = head(*CVS_OUT);
         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);  
             # 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 = '';  
             }  
             if ($lusr eq $oldLusr) {  
                 $usrprint = '';  
             }  
             else {  
                 $usrprint = $lusr;  
             }  
             $oldLrev = $lrev;  
             $oldLusr = $lusr;  
   
             # Set bold for text-based browsers only - graphical    my %d = scan_directives(@buf);
             # browsers show bold fonts a bit wider than regular fonts,  
             # so it looks irregular.  
             print "<b>" if ($isCurrentRev && $is_textbased);  
   
             printf "%s%s %-8s %4d:",    while (@buf || !eof(*CVS_OUT)) {
                     $revprint,  
                     $isCurrentRev ? '!' : ' ',  
                     $usrprint,  
                     $lineNr;  
             print spacedHtmlText($line, $d{'tabstop'});  
   
             print "</b>" if ($isCurrentRev && $is_textbased);      $_ = @buf ? shift @buf : <CVS_OUT>;
         }      my @words = split;
         elsif ($words[0] eq "ok") {  
             # We could complain about any text received after this, like the      # Adding one is for the (single) space which follows $words[0].
             # CVS command line client.  But for simplicity, we don't.      my $rest = substr($_, length($words[0]) + 1);
         }      if ($words[0] eq "E") {
         elsif ($words[0] eq "error") {        next;
             fatal("500 Internal Error", "Error occured during annotate: <b>$_</b>");      } 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);
   
         # 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 = '';
         }
   
         $usrprint = ($lusr eq $oldLusr) ? '' : $lusr;
         $oldLrev = $lrev;
         $oldLusr = $lusr;
   
         print $is_textbased ? '<b>' : '<span class="current-rev">'
           if $isCurrentRev;
   
         $usrprint = sprintf('%-8s', $usrprint);
         printf '%s%s %s %4d:', $revprint, $isCurrentRev ? '!' : ' ',
           htmlquote($usrprint), $lineNr;
         print spacedHtmlText($line, $d{tabstop});
   
         print $is_textbased ? '</b>' : '</span>' if $isCurrentRev;
   
       } 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: <b>%s</b>', $_);
     }      }
     if ($annTable) {    }
         print "</table>";    $h->finish();
     }  
     else {    if ($annTable) {
         print "</pre>";      print "</table>";
     }    } else {
     close ($reader) || warn "cannot close: $!";      print "</pre>";
     wait;    }
     html_footer();
 }  }
   
 ###############################  ###############################
 # make Checkout  # make Checkout
 ###############################  ###############################
 sub doCheckout($$) {  sub doCheckout($$$)
     my ($fullname, $rev) = @_;  {
     my ($mimetype,$revopt);    my ($fullname, $rev, $tag) = @_;
     my $fh = do {local(*FH);};    $rev = $tag || undef if (!$rev || $rev eq '.');
   
     if ($rev eq 'HEAD' || $rev eq '.') {    # Start resolving whether we will do a markup view or not.
         $rev = undef;    my $do_markup = undef;
     }    my $want_type = $input{'content-type'};
   
     # make sure the revisions a wellformed, for security    # No markup if markup disallowed.
     # reasons ..    $do_markup = 0 unless $allow_markup;
     if (defined($rev) && $rev =~ /[^\w.]/) {  
         &fatal("404 Not Found",    # No markup if checkout magic cookie in URL.
                 "Malformed query \"$ENV{QUERY_STRING}\"");    $do_markup = 0 if (!defined($do_markup) && $doCheckout);
   
     # 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;
     }      }
     }
   
     # get mimetype    # Ok, if $do_markup is still undefined, we know that a download has not been
     if (defined($input{"content-type"}) && ($input{"content-type"} =~ /\S\/\S/)) {    # explicitly asked.  For the last check further down below we'll need to
         $mimetype = $input{"content-type"}    # know if the file is binary, and possibly run a log on it.
     my $needlog = $do_markup || $use_moddate;
   
     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 {    } else {
         $mimetype = &getMimeTypeFromSuffix($fullname);      $revopt = "-rHEAD";
       if ($needlog) {
         readLog($fullname);
         $moddate = $date{$symrev{HEAD}};
     }      }
     }
   
     if (defined($rev)) {    my $cr = abs_path($cvsroot) || $cvsroot;
         $revopt = "-r$rev";    # abs_path() taints when run as a CGI...
         if ($use_moddate) {    if ($cr =~ VALID_PATH) {
             readLog($fullname,$rev);      $cr = $1;
             $moddate=$date{$rev};    } else {
         }      fatal('500 Internal Error', 'Illegal CVS root: <code>%s</code>', $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);
   
     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: <pre>%s</pre>',
           $? >> 8 || -1, $err)
       unless $h;
   
     if (eof(CVS_ERR)) {
       $h->finish();
       fatal("404 Not Found", '%s is not (any longer) pertinent', $where);
     }
   
     #===================================================================
     #Checking out squid/src/ftp.c
     #RCS:  /usr/src/CVS/squid/src/ftp.c,v
     #VERS: 1.1.1.28.6.2
     #***************
   
     # Parse CVS header
     my ($revision, $filename, $cvsheader);
     $filename = "";
     while (<CVS_ERR>) {
       last if (/^\*\*\*\*/);
       $revision = $1 if (/^VERS: (.*)$/);
   
       if (/^Checking out (.*)$/) {
         ($filename = $1) =~ s|^\./+||;
     }      }
     else {      $cvsheader .= $_;
         $revopt = "-rHEAD";    }
         if ($use_moddate) {    close(CVS_ERR);
             readLog($fullname);  
             $moddate=$date{$symrev{HEAD}};    if ($filename ne $where) {
         }      $h->finish();
       fatal("500 Internal Error",
             'Unexpected output from cvs co: <pre>%s</pre> ' .
             '(expected "<code>%s</code>" but got "<code>%s</code>")',
             $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();
     }      }
   
     ### just for the record:      # Here we know the last modified date, but don't know if tags have been
     ### 'cvs co' seems to have a bug regarding single checkout of      # added afterwards (those are shown in the markup view): no last-modified.
     ### directories/files having spaces in it;      cvswebMarkup(\*CVS_OUT, $fullname, $revision, $isbin, $mimetype, $needlog);
     ### this is an issue that should be resolved on cvs's side  
     #      $h->finish() unless $linked;
     # Safely for a child process to read from.  
     if (! open($fh, "-|")) { # child    } else {
         open(STDERR, ">&STDOUT"); # Redirect stderr to stdout      http_header($want_type || $mimetype, $moddate);
         exec($CMD{cvs}, @cvs_options, '-d', $cvsroot, 'co', '-p', $revopt, $where);      local $/ = undef;
       print <CVS_OUT>;
       $h->finish();
     }
   }
   
   
   sub cvswebMarkup($$$$$$;$)
   {
     my ($filehandle, $fullname, $rev, $isbin, $mimetype, $logged, $mod) = @_;
   
     (my $pathname = $where) =~ s|((?<=/)Attic/)?[^/]*$||;
     (my $filename = $where) =~ s|^.*/||;
   
     navigateHeader($scriptwhere, $pathname, $filename, $rev, 'view', $mod);
   
     print <<EOF;
   <hr />
   <div class="log-markup">
   File:&nbsp;
   EOF
     print &clickablePath($where, 1), "<br />\n";
   
     if ($show_log_in_markup) {
       readLog($fullname) unless $logged; #,$rev);
       printLog($rev, $mimetype, $isbin);
     } else {
       print "Revision: <b>$rev</b><br />\n";
       print 'Tag: ', htmlquote($input{only_with_tag}), "<br />\n"
         if $input{only_with_tag};
     }
     print "</div>\n<hr />";
     my $url = download_url(uri_escape($filename), $rev, $mimetype);
   
     if ($mimetype =~ m|^image/|i) {
       printf '<img src="%s" alt="%s" /><br />',
         $url . $barequery, htmlquote($filename);
     } elsif (lc($mimetype) eq 'application/pdf') {
       printf '<embed src="%s" width="100%%" height="100%%" /><br />',
         $url . $barequery;
     } else {
       print "<pre>\n";
       my $linenumbers = $input{ln} || 0;
         my $ln  = 0;
         my @buf = ();
         my $ts  = undef;
   
         if ($preformat_in_markup) {
           # prefetch several lines
           @buf = head($filehandle);
           my %d = scan_directives(@buf);
           $ts = $d{tabstop};
         }
   
         while (@buf || !eof($filehandle)) {
           $_ = @buf ? shift @buf : <$filehandle>;
           if ($linenumbers) {
             $ln++;
             printf '<a id="l%d" class="src">%5d: </a>', ($ln) x 2;
           }
           print $preformat_in_markup ? spacedHtmlText($_, $ts) : htmlquote($_);
         }
       print "</pre>\n";
     }
     html_footer();
   }
   
   
   sub viewable($)
   {
     return shift =~ m{^((text|image)/|application/pdf)}i;
   }
   
   
   ###############################
   # Show Colored Diff
   ###############################
   sub doDiff($$$$$$)
   {
     my ($fullname, $r1, $tr1, $r2, $tr2, $f) = @_;
   
     if (forbidden($fullname)) {
       fatal('403 Forbidden', 'Access to %s forbidden.', $where);
     }
   
     my ($rev1, $sym1);
     if ($r1 =~ /([^:]+)(:(.+))?/) {
       $rev1 = $1;
       $sym1 = $3;
     }
     if ($r1 eq 'text') {
       $rev1 = $tr1;
       $sym1 = "";
     }
   
     my ($rev2, $sym2);
     if ($r2 =~ /([^:]+)(:(.+))?/) {
       $rev2 = $1;
       $sym2 = $3;
     }
     if ($r2 eq 'text') {
       $rev2 = $tr2;
       $sym2 = "";
     }
   
     #
     # 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 $mimetype = getMimeType($fullname);
   
     #
     #  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}) {
   
     if (eof($fh)) {      if ($diffcmd->{args} && ref($diffcmd->{args}) ne 'ARRAY') {
         &fatal("404 Not Found",        fatal('500 Internal Error',
                "$where is not (any longer) pertinent");              'Configuration error: arguments to external diff tools must ' .
               'be given as array refs.  See "<code>%s</code>" in ' .
               '<code>%%DIFF_COMMANDS</code>.',
               $diffcmd->{name});
     }      }
 #===================================================================  
 #Checking out squid/src/ftp.c  
 #RCS:  /usr/src/CVS/squid/src/ftp.c,v  
 #VERS: 1.1.1.28.6.2  
 #***************  
   
     # Parse CVS header      (my $cvsname = $where) =~ s/\.diff$//;
     my ($revision, $filename, $cvsheader);  
     $filename = "";      # Create two temporary files with the two revisions
     while(<$fh>) {      my $temp_fn1 = checkout_to_temp($cvsroot, $cvsname, $rev1);
         last if (/^\*\*\*\*/);      my $temp_fn2 = checkout_to_temp($cvsroot, $cvsname, $rev2);
         $revision = $1 if (/^VERS: (.*)$/);  
         if (/^Checking out (.*)$/) {      # Execute chosen diff binary.
                 $filename = $1;      local (*DIFF_OUT);
                 $filename =~ s/^\.\/*//;      my @cmd = ($diffcmd->{cmd});
         }      push(@cmd, @{$diffcmd->{args}}) if $diffcmd->{args};
         $cvsheader .= $_;      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: <pre>%s</pre>',
               $? >> 8 || -1, $err);
     }      }
     if ($filename ne $where) {  
         &fatal("500 Internal Error",  
                "Unexpected output from cvs co: $cvsheader");  
     }  
     $| = 1;  
   
     if ($mimetype eq "text/x-cvsweb-markup") {      http_header($diffcmd->{type} || 'text/plain');
         &cvswebMarkup($fh,$fullname,$revision);      local $/ = undef;
       print <DIFF_OUT>;
       $h->finish();
       unlink($temp_fn1);
       unlink($temp_fn2);
   
       exit;
     }
   
     #
     # Normal CVS diff.
     #
   
     $f = $DEFAULTVALUE{f} || 'u' if ($f =~ /^ext\d*$/);
     my $difftype = $DIFFTYPES{$f};
     if (!$difftype) {
       fatal("400 Bad arguments", 'Diff format %s not understood', $f);
     }
   
     my @difftype       = @{$difftype->{opts}};
     my $human_readable = $difftype->{colored};
   
     # Apply special diff options.
     push @difftype, '-p' if $showfunc;
   
     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;
     } 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";
         }
     }      }
     else {      print $_;
         http_header($mimetype);    }
         print <$fh>;    close($fh);
     }  
     close($fh);  
 }  }
   
 sub cvswebMarkup($$$) {  
     my ($filehandle,$fullname,$revision) = @_;  
     my ($pathname, $filename);  
   
     ($pathname = $where) =~ s/(Attic\/)?[^\/]*$//;  ###############################
     ($filename = $where) =~ s/^.*\///;  # Show Logs ..
     my ($fileurl) = urlencode($filename);  ###############################
   sub getDirLogs($$@)
   {
     my ($cvsroot, $dirname, @otherFiles) = @_;
     my $tag = $input{only_with_tag};
     my $DirName = catdir($cvsroot, $where);
   
     http_header();    my @files = &safeglob("$DirName/*,v");
     push (@files, &safeglob("$DirName/Attic/*,v")) unless $input{hideattic};
     foreach my $file (@otherFiles) {
       push(@files, catfile($DirName, $file));
     }
   
     navigateHeader($scriptwhere, $pathname, $filename, $revision, "view");    # Weed out unreadable files.
     print "<HR noshade>";    my $i = 0;
     print "<table width=\"100%\"><tr><td bgcolor=\"$markupLogColor\">";    my @unreadable = ();
     print "File: ", &clickablePath($where, 1);    while ($i < scalar(@files)) {
     print "&nbsp;(";      # Note: last modified files from subdirs returned by
     &download_link($fileurl, $revision, "download");      # findLastModifiedSubdirs() come without the ,v suffix so they're not
     print ")";      # found here, but have already been checked for readability.  *cough*
     if (!$defaultTextPlain) {      if (-r $files[$i] || !-e _) {
         print "&nbsp;(";        $i++;
         &download_link($fileurl, $revision, "as text",      } else {
                "text/plain");        push(@unreadable, splice(@files, $i, 1));
         print ")";  
     }      }
     print "<BR>\n";    }
     if ($show_log_in_markup) {  
         readLog($fullname); #,$revision);    # If there are no files, we're done.
         printLog($revision,0);    return @unreadable unless @files;
   
     my @cmd = ($CMD{rlog});
     # Can't use -r<tag> as '-' is allowed in tagnames,
     # but misinterpreted by rlog.
     push(@cmd, '-r') unless 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;
         }
     }      }
     else {      exec(@cmd, @files) or exit -1;
         print "Version: <B>$revision</B><BR>\n";    }
         print "Tag: <B>", $input{only_with_tag}, "</b><br>\n" if    undef @cmd;
             $input{only_with_tag};  
     my $state = 'start';
     my ($date, $branchpoint, $branch, $log, @filetags);
     my ($rev, $revision, $revwanted, $filename, $head, $author, $keywordsubst);
   
     while (<$fh>) {
       if ($state eq "start") {
   
         #Next file. Initialize file variables
         $rev         = '';
         $revwanted   = '';
         $branch      = '';
         $branchpoint = '';
         $filename    = '';
         $log         = '';
         $revision    = '';
         %symrev      = ();
         @filetags    = ();
         $keywordsubst= '';
   
         #jump to head state
         $state = "head";
     }      }
     print "</td></tr></table>";  
     my $url = download_url($fileurl, $revision, $mimetype);      again:
     print "<HR noshade>";  
     if ($mimetype =~ /^image/) {      if ($state eq "head") {
         printf '<IMG SRC="%s"><BR>', hrefquote("$url$barequery");  
         #$rcsfile = $1 if (/^RCS file: (.+)$/); #not used (yet)
   
         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;
     }      }
     elsif ($mimetype =~ m%^application/pdf%) {  
         printf '<EMBED SRC="%s" WIDTH="100%"><BR>', hrefquote("$url$barequery");      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") {
               $state = "skip";
               next;
             }
           }
   
           foreach my $tagfound (@filetags) {
             $tags{$tagfound} = 1;
           }
           $state = "head";
           goto again;
         }
     }      }
     elsif ($preformat_in_markup) {  
         print "<PRE>";  
   
         # prefetch several lines      if ($state eq "log") {
         my @buf = head($filehandle);        if ($_ =~ LOG_REVSEPR || $_ =~ LOG_FILESEPR) {
   
         my %d = scan_directives(@buf);          # End of a log entry.
           my $revbranch = $rev;
           $revbranch =~ s/\.\d+$//;
   
         while (@buf || !eof($filehandle)) {          if ($revwanted eq '' && $branch ne '' && $branch eq $revbranch
             $_ = @buf ? shift @buf : <$filehandle>;              || !defined($tag))
           {
             $revwanted = $rev;
           }
   
             print spacedHtmlText($_, $d{'tabstop'});          if ($revwanted ne ''
         }              ? $rev eq $revwanted
         print "</PRE>";              : $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 .= $_;
         }
     }      }
     else {  
         print "<PRE>";      if ($_ =~ LOG_FILESEPR) {
         while (<$filehandle>) {        $state = "start";
             print htmlquote($_);        next;
         }  
         print "</PRE>";  
     }      }
 }    }
   
 sub viewable($) {    my $linesread = $. || 0;
     my ($mimetype) = @_;    close($fh);
   
     $mimetype =~ m%^((text|image)/|application/pdf)% ;    if ($linesread == 0) {
       fatal('500 Internal Error',
             'Failed to spawn GNU rlog on <em>"%s"</em>.<br /><br />Did you set the <b><code>@command_path</code></b> in your configuration file correctly? (Currently: "<code>%s</code>")',
             htmlquote(join(', ', @files)), join(':', @command_path));
     }
   
     return @unreadable;
 }  }
   
 ###############################  
 # Show Colored Diff  
 ###############################  
 sub doDiff($$$$$$) {  
         my($fullname, $r1, $tr1, $r2, $tr2, $f) = @_;  
         my $fh = do {local(*FH);};  
         my ($rev1, $rev2, $sym1, $sym2, $f1, $f2);  
   
         if ($r1 =~ /([^:]+)(:(.+))?/) {  sub readLog($;$)
             $rev1 = $1;  {
             $sym1 = $3;    my ($fullname, $revision) = @_;
         }    my ($symnames, $head, $rev, $br, $brp, $branch, $branchrev);
         if ($r1 eq 'text') {  
             $rev1 = $tr1;  
             $sym1 = "";  
         }  
         if ($r2 =~ /([^:]+)(:(.+))?/) {  
             $rev2 = $1;  
             $sym2 = $3;  
         }  
         if ($r2 eq 'text') {  
             $rev2 = $tr2;  
             $sym2 = "";  
         }  
   
         # make sure the revisions a wellformed, for security    undef %symrev;
         # reasons ..    undef %revsym;
         if ($rev1 =~ /[^\w.]/ || $rev2 =~ /[^\w.]/) {    undef @allrevisions;
             &fatal("404 Not Found",    undef %date;
                     "Malformed query \"$ENV{QUERY_STRING}\"");    undef %author;
         }    undef %state;
 #    undef %difflines;
 # rev1 and rev2 are now both numeric revisions.    undef %log;
 # Thus we do a DWIM here and swap them if rev1 is after rev2.    $keywordsubstitution = '';
 # 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};  
   
         if (!$difftype) {    my $fh = do { local (*FH); };
             fatal ("400 Bad arguments", "Diff format $f not understood");    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;
       }
     }
   
         my @difftype       = @{$difftype->{'opts'}};    my $curbranch = undef;
         my $human_readable = $difftype->{'colored'};    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));
   
         # apply special options    # each log entry is of the form:
         if ($showfunc) {    # ----------------------------
             push @difftype, '-p' if $f ne 's';    # revision 3.7.1.1
     # date: 1995/11/29 22:15:52;  author: fenner;  state: Exp;  lines: +5 -3
     # log info
     # ----------------------------
   
             my($re1, $re2);    # For a locked revision, the first line after the separator
     # becomes smth like
     # revision 9.19       locked by: vassilii;
   
             while (($re1, $re2) = each %funcline_regexp) {    logentry:
                 if ($fullname =~ /$re1/) {  
                     push @difftype, '-F', $re2;  
                     last;  
                 }  
             }  
         }  
         if ($human_readable) {  
             if ($hr_ignwhite) {  
                 push @difftype, '-w';  
             }  
             if ($hr_ignkeysubst) {  
                 push @difftype, '-kk';  
             }  
         }  
         if (! open($fh, "-|")) { # child  
             open(STDERR, ">&STDOUT"); # Redirect stderr to stdout  
             exec($CMD{rcsdiff}, @difftype, "-r$rev1", "-r$rev2", $fullname);  
         }  
         if ($human_readable) {  
             http_header();  
             &human_readable_diff($fh, $rev2);  
             gzipclose();  
             exit;  
         }  
         else {  
             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...)  
 #  
         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);  
 }  
   
 ###############################    while ($_ !~ LOG_FILESEPR) {
 # Show Logs ..      $_ = <$fh>;
 ###############################      last logentry if (!defined($_));    # EOF
 sub getDirLogs($$@) {      if (/^revision (\d+(?:\.\d+)+)/) {
     my ($cvsroot,$dirname,@otherFiles) = @_;        $rev = $1;
     my ($state,$otherFiles,$tag, $file, $date, $branchpoint, $branch, $log);        unshift(@allrevisions, $rev);
     my ($rev, $revision, $revwanted, $filename, $head, $author);      } elsif ($_ =~ LOG_FILESEPR || $_ =~ LOG_REVSEPR) {
         next logentry;
       } else {
   
     $tag = $input{only_with_tag};        # 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', $_);
       }
   
     my ($DirName) = "$cvsroot/$where";    line:
     my (@files, @filetags);      while (<$fh>) {
     my $fh = do {local(*FH);};        next line if (/^branches:\s/);
         last line if ($_ =~ LOG_FILESEPR || $_ =~ LOG_REVSEPR);
         $log{$rev} .= $_;
       }
     }
     close($fh);
   
     push(@files, &safeglob("$DirName/*,v"));    @revorder = reverse sort { revcmp($a, $b) } @allrevisions;
     push(@files, &safeglob("$DirName/Attic/*,v")) if (!$input{'hideattic'});  
     foreach $file (@otherFiles) {    #
         push(@files, "$DirName/$file");    # 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});
   
     # just execute rlog if there are any files    #
     if ($#files < 0) {    # Now that we know all of the revision numbers, we can associate
         return;    # 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, $_);
   
         #
         # 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;
   
         my $regex = '^' . quotemeta($branchrev) . '\b';
         $regex = qr/$regex/;
   
         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 .= sprintf("<option value=\"%s:%s\">%s</option>\n",
                       htmlquote($rev), (htmlquote($_)) x 2);
     }
   
     if (defined($tag)) {    my ($onlyonbranch, $onlybranchpoint);
         #can't use -r<tag> as - is allowed in tagnames, but misinterpreated by rlog..    if ($onlyonbranch = $input{only_with_tag}) {
         if (! open($fh, "-|")) {      $onlyonbranch = $symrev{$onlyonbranch};
             open(STDERR, '>/dev/null'); # rlog may complain; ignore.      if ($onlyonbranch && $onlyonbranch =~ s/\b0\.//) {
             exec($CMD{rlog}, @files);        ($onlybranchpoint = $onlyonbranch) =~ s/\.\d+$//;
         }      } else {
         $onlybranchpoint = $onlyonbranch;
     }      }
     else {  
         if (! open($fh, "-|")) {      if (!defined($onlyonbranch) || $onlybranchpoint eq "") {
             open(STDERR, '>/dev/null'); # rlog may complain; ignore.        fatal("404 Tag not found", 'Tag "<code>%s</code>" is not defined.',
             exec($CMD{rlog}, '-r', @files);              $input{only_with_tag});
         }  
     }      }
     $state = "start";    }
     while (<$fh>) {  
         if ($state eq "start") {  
             #Next file. Initialize file variables  
             $rev = '';  
             $revwanted = '';  
             $branch = '';  
             $branchpoint = '';  
             $filename = '';  
             $log = '';  
             $revision = '';  
             %symrev = ();  
             @filetags = ();  
             #jump to head state  
             $state = "head";  
         }  
         print "$state:$_" if ($verbose);  
 again:  
         if ($state eq "head") {  
             #$rcsfile = $1 if (/^RCS file: (.+)$/); #not used (yet)  
   
             if (/^Working file: (.+)$/) {    undef @revisions;
                 $filename = $1;  
             } elsif (/^head: (.+)$/) {    foreach (@allrevisions) {
                 $head = $1;      ($br  = $_)  =~ s/\.\d+$//;
             } elsif (/^branch: (.+)$/) {      ($brp = $br) =~ s/\.\d+$//;
                 $branch = $1      next if ($onlyonbranch
             } elsif (/^symbolic names:/) {               && $br ne $onlyonbranch
                 $state = "tags";               && $_  ne $onlybranchpoint);
                 ($branch = $head) =~ s/\.\d+$// if $branch eq '';      unshift(@revisions, $_);
                 $branch =~ s/(\d+)$/0.$1/;    }
                 $symrev{MAIN} = $branch;  
                 $symrev{HEAD} = $branch;    if ($logsort eq "date") {
                 $alltags{MAIN} = 1;  
                 $alltags{HEAD} = 1;      # Sort the revisions in commit order an secondary sort on revision
                 push (@filetags, "MAIN", "HEAD");      # (secondary sort needed for imported sources, or the first main
             } elsif (/$LOG_REVSEPARATOR/o) {      # revision gets before the same revision on the 1.1.1 branch)
                 $state = "log";      @revdisplayorder =
                 $rev = '';        sort { $date{$b} <=> $date{$a} || -revcmp($a, $b) } @revisions;
                 $date = '';    } elsif ($logsort eq "rev") {
                 $log = '';  
                 # Try to reconstruct the relative filename if RCS spits out a full path      # Sort the revisions in revision order, highest first
                 $filename =~ s%^\Q$DirName\E/%%;      @revdisplayorder = reverse sort { revcmp($a, $b) } @revisions;
             }    } else {
             next;  
         }      # No sorting. Present in the same order as rlog / cvs log
         if ($state eq "tags") {      @revdisplayorder = @revisions;
             if (/^\s+(.+):\s+([\d\.]+)\s+$/) {    }
                 push (@filetags, $1);  
                 $symrev{$1} = $2;    return $curbranch;
                 $alltags{$1} = 1;  }
                 next;  
             } elsif (/^\S/) {  
                 if (defined($tag)) {  sub getDiffLinks($$$)
                     if(defined($symrev{$tag}) || $tag eq "HEAD") {  {
                         $revwanted = $symrev{$tag eq "HEAD" ? "MAIN" : $tag};    my ($url, $mimetype, $isbin) = @_;
                         ($branch = $revwanted) =~ s/\b0\.//;  
                         ($branchpoint = $branch) =~ s/\.?\d+$//;    my @links = ();
                         $revwanted = '' if ($revwanted ne $branch);    if (!$isbin) { # Offer ordinary diff only for non-binary files.
                     } elsif ($tag ne "HEAD") {      push(@links, &link('preferred', $url));
                         print "Tag not found, skip this file" if ($verbose);      for my $difftype ($DIFFTYPES{$defaultDiffType}{colored} ? qw(u) : qw(h)) {
                         $state = "skip";        my $f = $difftype eq $defaultDiffType ? '' : $difftype;
                         next;        push(@links,
                     }             &link(htmlquote(lc($DIFFTYPES{$difftype}{descr})), "$url;f=$f"));
                 }  
                 foreach my $tagfound (@filetags) {  
                     $tags{$tagfound} = 1;  
                 }  
                 $state = "head";  
                 goto again;  
             }  
         }  
         if ($state eq "log") {  
             if (/$LOG_REVSEPARATOR/o || /$LOG_FILESEPARATOR/o) {  
                 # 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);  
                 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 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;  
                 # 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 (.*)$/) {  
                 $rev = $1;  
                 next;  
             }  
             else {  
                 $log .= $_;  
             }  
         }  
         if (/$LOG_FILESEPARATOR/o) {  
             $state = "start";  
             next;  
         }  
     }      }
     if ($. == 0) {    }
         fatal("500 Internal Error",    if (my $extdiffs = $DIFF_COMMANDS{lc($mimetype)}) {
               "Failed to spawn GNU rlog on <em>'".join(", ", @files)."'</em><p>Did you set the <b>\$command_path</b> in your configuration file correctly ? (Currently '$command_path'");      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});
     }      }
     close($fh);    }
     return @links;
 }  }
   
 sub readLog($;$) {  
         my($fullname,$revision) = @_;  
         my ($symnames, $head, $rev, $br, $brp, $branch, $branchrev);  
         my $fh = do {local(*FH);};  
   
         if (defined($revision)) {  sub printLog($$$;$$)
             $revision = "-r$revision";  {
         }    # inlogview: 1 if in log view, otherwise in markup view.
         else {    ($_, my $mimetype, my $isbin, my $inlogview, my $isSelected) = @_;
             $revision = "";    (my $br  = $_)  =~ s/\.\d+$//;
         }    (my $brp = $br) =~ s/\.?\d+$//;
   
         undef %symrev;    print "<a name=\"rev$_\"></a>";
         undef %revsym;    if (defined($revsym{$_})) {
         undef @allrevisions;      foreach my $sym (split(", ", $revsym{$_})) {
         undef %date;        print '<a name="', htmlquote($sym), '"></a>';
         undef %author;      }
         undef %state;    }
         undef %difflines;    if ($revsym{$br} && !defined($nameprinted{$br})) {
         undef %log;      foreach my $sym (split(", ", $revsym{$br})) {
         print '<a name="', htmlquote($sym), '"></a>';
       }
       $nameprinted{$br} = 1;
     }
   
         print("Going to rlog '$fullname'\n") if ($verbose);    print "\n Revision <b>$_</b>";
         if (! open($fh, "-|")) { # child    if (/^1\.1\.1\.\d+$/) {
             if ($revision ne '') {      print " <i>(vendor branch)</i>";
                 exec($CMD{rlog}, $revision, $fullname);    }
             }  
             else {  
                 exec($CMD{rlog}, $fullname);  
             }  
         }  
         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));  
   
 # each log entry is of the form:    (my $filename = $where) =~ s|^.*/||;
 # ----------------------------    my $fileurl   = uri_escape($filename);
 # revision 3.7.1.1    undef $filename;
 # date: 1995/11/29 22:15:52;  author: fenner;  state: Exp;  lines: +5 -3  
 # log info  
 # ----------------------------  
         logentry:  
         while (!/$LOG_FILESEPARATOR/o) {  
             $_ = <$fh>;  
             last logentry if (!defined($_));    # EOF  
             print "R:", $_ if ($verbose);  
             if (/^revision ([\d\.]+)/) {  
                 $rev = $1;  
                 unshift(@allrevisions,$rev);  
             }  
             elsif (/$LOG_FILESEPARATOR/o || /$LOG_REVSEPARATOR/o) {  
                 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;  
 #               &fatal("500 Internal Error","Error parsing RCS output: $_");  
             }  
             $_ = <$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;  
                 # 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: $_");  
             }  
             line:  
             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;    my $isDead = ($state{$_} eq 'dead');
         print "Done sorting revisions",join(" ",@revorder),"\n" if ($verbose);    if (!$isDead) {
   
 #      print ': ', download_link($fileurl, $_, 'download', $mimetype);
 # 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+$//  
             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;  
   
         foreach (reverse sort keys %symrev) {      my @vlinks = ();
             $rev = $symrev{$_};      push(@vlinks, display_link($fileurl, $_, 'text', 'text/plain'))
             if ($rev =~ /^((.*)\.)?\b0\.(\d+)$/) {        unless $isbin;
                 push(@branchnames, $_);      push(@vlinks, display_link($fileurl, $_, 'markup', 'text/x-cvsweb-markup'))
                 #        if ($allow_markup && $inlogview && (!$isbin || viewable($mimetype)));
                 # A revision number of A.B.0.D really translates into      if (!$isbin && $allow_annotate) {
                 # "the highest current revision on branch A.B.D".        push(@vlinks,
                 #             &link('annotated',
                 # If there is no branch A.B.D, then it translates into                   sprintf('%s?annotate=%s%s', $fileurl, $_, $barequery)));
                 # the head A.B .      }
                 #      print ' - view: ', join(', ', @vlinks) if @vlinks;
                 # This reasoning also applies to the main branch A.B,      undef @vlinks;
                 # 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;  
   
                 foreach my $r (@revorder) {      if (!$isbin && $allow_version_select) {
                     if ($r =~ /^${regex}\b/) {        print ' - ';
                         $rev = $branchrev;        if ($isSelected) {
                         last;          print '<b>[selected&nbsp;for&nbsp;diffs]</b>';
                     }        } else {
                 }          print &link('select&nbsp;for&nbsp;diffs',
                 next if ($rev eq "");                      sprintf('%s?r1=%s%s#rev%s',
                 if ($rev ne $head && $head ne "") {                              $fileurl, $_, $barequery, $_));
                     $branchpoint{$head} .= ", " if ($branchpoint{$head});        }
                     $branchpoint{$head} .= $_;      }
                 }    }
             }    print "<br />\n";
             $revsym{$rev} .= ", " if ($revsym{$rev});  
             $revsym{$rev} .= $_;  
             $sel .= "<OPTION VALUE=\"${rev}:${_}\">$_\n";  
         }  
         print "Done associating revisions with branches\n" if ($verbose);  
   
         my ($onlyonbranch, $onlybranchpoint);    print '<i>';
         if ($onlyonbranch = $input{'only_with_tag'}) {    if (@mytz) {
             $onlyonbranch = $symrev{$onlyonbranch};      my ($est) = $mytz[(localtime($date{$_}))[8]];
             if ($onlyonbranch =~ s/\b0\.//) {      print scalar localtime($date{$_}), " $est</i> (";
                 ($onlybranchpoint = $onlyonbranch) =~ s/\.\d+$//;    } else {
             }      print scalar gmtime($date{$_}), " UTC</i> (";
             else {    }
                 $onlybranchpoint = $onlyonbranch;    print readableTime(time() - $date{$_}, 1), ' ago)';
             }    print ' by <i>', htmlquote($author{$_}), "</i><br />\n";
             if (!defined($onlyonbranch) || $onlybranchpoint eq "") {  
                 fatal("404 Tag not found","Tag $input{'only_with_tag'} not defined");  
             }  
         }  
   
         undef @revisions;    printf("Branches: %s<br />\n", link_tags($revsym{$br})) if $revsym{$br};
     printf("CVS tags: %s<br />\n", link_tags($revsym{$_}))  if $revsym{$_};
     printf("Branch point for: %s<br />\n", link_tags($branchpoint{$_}))
       if $branchpoint{$_};
   
         foreach (@allrevisions) {    # Find the previous revision
             ($br = $_) =~ s/\.\d+$//;    my $prev;
             ($brp = $br) =~ s/\.\d+$//;    my @prevrev = split(/\./, $_);
             next if ($onlyonbranch && $br ne $onlyonbranch &&    do {
                                         $_ ne $onlybranchpoint);      if (--$prevrev[$#prevrev] <= 0) {
             unshift(@revisions,$_);  
         }  
   
         if ($logsort eq "date") {        # If it was X.Y.Z.1, just make it X.Y
             # Sort the revisions in commit order an secondary sort on revision        pop (@prevrev);
             # (secondary sort needed for imported sources, or the first main        pop (@prevrev);
             # revision gets before the same revision on the 1.1.1 branch)      }
             @revdisplayorder = sort {$date{$b} <=> $date{$a} || -revcmp($a, $b)} @revisions;      $prev = join (".", @prevrev);
         }    } until (defined($date{$prev}) || $prev eq "");
         elsif ($logsort eq "rev") {  
             # 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;  
         }  
   
 }    if ($isDead) {
       print "<b><i>FILE REMOVED</i></b><br />\n";
     } else {
       my %diffrev = ();
       $diffrev{$_} = 1;
       $diffrev{""} = 1;
       my $diff = 'Diff to:';
       my $printed = 0;
   
 sub printDiffLinks($$) {      #
     my($text, $url) = @_;      # Offer diff to previous revision
     my @extra;      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;
         }
       }
   
     local $_;      #
     for ($DIFFTYPES{$defaultDiffType}{'colored'} ? qw(u) : qw(h)) {      # Plus, if it's on a branch, and it's not a vendor branch,
         my $f = $_ eq $defaultDiffType ? '' : $_;      # 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;
         }
       }
   
         push @extra, &link(lc $DIFFTYPES{$_}{'descr'}, "$url&f=$f");      #
       # 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);
   
         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);
   
           if (@tmp1 < @tmp2) {
             $nextmain = $next;
             last;
           }
   
           # 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 (!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;
           }
         }
     }      }
   
     print &link($text, $url), ' (', join(', ', @extra), ')';      # 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;
         }
       }
   
       print "<br />\n" if $printed;
     }
   
     if ($prev ne "" && $difflines{$_}) {
       printf "Changes since revision %s: %s lines<br />\n",
         htmlquote($prev), htmlquote($difflines{$_});
     }
   
     print "<pre class=\"log\">\n";
     print &htmlify($log{$_}, $allow_log_extra);
     print "</pre>\n";
 }  }
   
 sub printLog($;$) {  
         my ($link, $br, $brp);  
         ($_,$link) = @_;  
         ($br = $_) =~ s/\.\d+$//;  
         ($brp = $br) =~ s/\.?\d+$//;  
         my ($isDead, $prev);  
   
         $link = 1 if (!defined($link));  sub doLog($)
         $isDead = ($state{$_} eq "dead");  {
     my ($fullname) = @_;
   
         if ($link && !$isDead) {    my $curbranch = readLog($fullname);
             my ($filename);  
             ($filename = $where) =~ s/^.*\///;  
             my ($fileurl) = urlencode($filename);  
             print "<a NAME=\"rev$_\"></a>";  
             if (defined($revsym{$_})) {  
                 foreach my $sym (split(", ", $revsym{$_})) {  
                     print "<a NAME=\"$sym\"></a>";  
                 }  
             }  
             if (defined($revsym{$br}) && $revsym{$br} && !defined($nameprinted{$br})) {  
                 foreach my $sym (split(", ", $revsym{$br})) {  
                     print "<a NAME=\"$sym\"></a>";  
                 }  
                 $nameprinted{$br} = 1;  
             }  
             print "\n Revision ";  
             &download_link($fileurl, $_, $_,  
                            $defaultViewable ? "text/x-cvsweb-markup" : undef);  
             if ($defaultViewable) {  
                 print " / (";  
                 &download_link($fileurl, $_, "download", $mimetype);  
                 print ")";  
             }  
             if (not $defaultTextPlain) {  
                 print " / (";  
                 &download_link($fileurl, $_, "as text", "text/plain");  
                 print ")";  
             }  
             if (!$defaultViewable) {  
                 print " / (";  
                 &download_link($fileurl, $_, "view", "text/x-cvsweb-markup");  
                 print ")";  
             }  
             if ($allow_annotate) {  
                 print " - ";  
                 print &link('annotate',  
                             sprintf('%s/%s?annotate=%s%s',  
                                     $scriptname,  
                                     urlencode($where),  
                                     $_,  
                                     $barequery));  
             }  
             # 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 " - <b>[selected]</b>";  
                 }  
             }  
         }  
         else {  
             print "Revision <B>$_</B>";  
         }  
         if (/^1\.1\.1\.\d+$/) {  
             print " <i>(vendor branch)</i>";  
         }  
         if (defined @mytz) {  
             my ($est) = $mytz[(localtime($date{$_}))[8]];  
             print ", <i>", scalar localtime($date{$_}), " $est</i> (";  
         } else {  
             print ", <i>", scalar gmtime($date{$_}), " UTC</i> (";  
         }  
         print readableTime(time() - $date{$_},1), " ago)";  
         print " by ";  
         print "<i>", $author{$_}, "</i>\n";  
         print "<BR>Branch: <b>",$link?link_tags($revsym{$br}):$revsym{$br},"</b>\n"  
             if ($revsym{$br});  
         print "<BR>CVS Tags: <b>",$link?link_tags($revsym{$_}):$revsym{$_},"</b>"  
             if ($revsym{$_});  
         print "<BR>Branch point for: <b>",$link?link_tags($branchpoint{$_}):$branchpoint{$_},"</b>\n"  
             if ($branchpoint{$_});  
         # Find the previous revision  
         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 ($prev ne "") {  
             if ($difflines{$_}) {  
                 print "<BR>Changes since <b>$prev: $difflines{$_} lines</b>";  
             }  
         }  
         if ($isDead) {  
             print "<BR><B><I>FILE REMOVED</I></B>\n";  
         }  
         elsif ($link) {  
             my %diffrev = ();  
             $diffrev{$_} = 1;  
             $diffrev{""} = 1;  
             print "<BR>Diff";  
             #  
             # Offer diff to previous revision  
             if ($prev) {  
                 $diffrev{$prev} = 1;  
   
                 my $url = sprintf('%s.diff?r1=%s&r2=%s%s',    html_header("CVS log for $where");
                                   $scriptwhere,  
                                   $prev,  
                                   $_,  
                                   $barequery);  
   
                 print " to previous ";    my $upwhere = $where;
                 printDiffLinks($prev, $url);    (my $filename = $where) =~ s|^.*/||;
             }    my $backurl = "./$query#" . uri_escape($filename);
             #    if ($where =~ m|^(.*?)((?<=/)Attic/)?[^/]+$|) {
             # Plus, if it's on a branch, and it's not a vendor branch,      $upwhere = $1;
             # offer a diff with the branch point.      $backurl = ".$backurl" if $2; # skip over Attic
             if ($revsym{$brp} && !/^1\.1\.1\.\d+$/ && !defined($diffrev{$brp})) {    }
                 my $url = sprintf('%s.diff?r1=%s&r2=%s%s',  
                                   $scriptwhere,  
                                   $brp,  
                                   $_,  
                                   $barequery);  
   
                 print " to branchpoint ";    my $isbin = $keywordsubstitution =~ /b/;
                 printDiffLinks($brp, $url);    my $mimetype = getMimeType($filename, $isbin);
             }  
             #  
             # 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);  
                 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);  
                     if (@tmp1 < @tmp2) {  
                         $nextmain = $next;  
                         last;  
                     }  
                     # 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 (!defined($diffrev{$nextmain})) {  
                     $diffrev{$nextmain} = 1;  
   
                     my $url = sprintf('%s.diff?r1=%s&r2=%s%s',    print "<p>\n ";
                                       $scriptwhere,    print &link($backicon, $backurl), " <b>Up to ",
                                       $nextmain,      &clickablePath($upwhere, 1), "</b>\n</p>\n";
                                       $_,    print "<p>\n ";
                                       $barequery);    print &link('Request diff between arbitrary revisions', '#diff');
     if ($cvshistory_url) {
       (my $d = $upwhere) =~ s|/+$||;
       print ' - ', history_link($d, $filename);
     }
     print "\n</p>\n<hr />\n";
   
                     print " next main ";    print "<p>\n";
                     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',    my $explain = $isbin ? ' (i.e.: CVS considers this a binary file)' : '';
                                   $scriptwhere,    print "Keyword substitution: $keywordsubstitution$explain<br />\n";
                                   $input{'r1'},    if ($curbranch) {
                                   $_,      print "Default branch: ", ($revsym{$curbranch} || $curbranch);
                                   $barequery);    } else {
       print "No default branch";
     }
     print "<br />\n";
   
                 print " to selected ";    print 'Current tag: ', htmlquote($input{only_with_tag}), "<br />\n"
                 printDiffLinks($input{'r1'}, $url);      if $input{only_with_tag};
             }    print "</p>\n";
         }  
         print "<PRE>\n";  
         print &htmlify($log{$_}, 1);  
         print "</PRE>\n";  
 }  
   
 sub doLog($) {    undef %nameprinted;
         my($fullname) = @_;  
         my ($diffrev, $upwhere, $filename, $backurl);  
   
         readLog($fullname);    for my $r (@revdisplayorder) {
       print "<hr />\n";
       my $sel = (defined($input{r1}) && $input{r1} eq $r);
       print "<div class=\"diff-selected\">\n" if $sel;
       printLog($r, $mimetype, $isbin, 1, $sel);
       print "</div>\n" if $sel;
     }
   
         html_header("CVS log for $where");    printf(<<EOF, $scriptwhere);
         ($upwhere = $where) =~ s|(Attic/)?[^/]+$||;  <hr />
         ($filename = $where) =~ s|^.*/||;  <form method="get" action="%s.diff" id="diff_select">
         $backurl = $scriptname . "/" . urlencode($upwhere) . $query;  <fieldset>
         print &link($backicon, "$backurl#$filename"),  <legend>Diff request</legend>
           " <b>Up to ", &clickablePath($upwhere, 1), "</b><p>\n";  <p>
         print &link('Request diff between arbitrary revisions', '#diff');   <a name="diff">
         print '<HR NOSHADE>';    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.
    </a>
   </p>
   EOF
   
         if ($curbranch) {    foreach (@stickyvars) {
             print "Default branch: ", ($revsym{$curbranch} || $curbranch);      printf("<input type=\"hidden\" name=\"%s\" value=\"%s\" />\n",
         }             $_, htmlquote($input{$_}))
         else {        if (defined($input{$_}) &&
             print "No default branch";            (!defined($DEFAULTVALUE{$_}) || $input{$_} ne $DEFAULTVALUE{$_}));
         }    }
         print "<BR>\n";  
         if ($input{only_with_tag}) {  
             print "Current tag: $input{only_with_tag}<BR>\n";  
         }  
   
         undef %nameprinted;    print <<EOF;
   <table summary="Diff between arbitrary revisions">
   <tr>
   <td class="opt-label">
   <label for="r1" accesskey="1">Diffs between</label>
   </td>
   <td class="opt-value">
   <select id="r1" name="r1">
   <option value="text" selected="selected">Use Text Field</option>
   EOF
     print $sel, "</select>\n";
   
         for (my $i = 0; $i <= $#revdisplayorder; $i++) {    my $diffrev = defined($input{r1}) ?
             print "<HR size=1 NOSHADE>";      $input{r1} : $revdisplayorder[$#revdisplayorder];
             printLog($revdisplayorder[$i]);  
         }  
   
         print "<HR NOSHADE>";    printf(<<EOF, $inputTextSize, $diffrev);
         print "<A NAME=diff>\n";  <input type="text" size="%s" name="tr1" value="%s" onchange="this.form.r1.selectedIndex=0" />
         print "This form allows you to request diff's between any two\n";  </td>
         print "revisions of a file.  You may select a symbolic revision\n";  <td></td>
         print "name using the selection box or you may type in a numeric\n";  </tr>
         print "name using the type-in text box.\n";  <tr>
         print "</A><P>\n";  <td class="opt-label">
         print "<FORM METHOD=\"GET\" ACTION=\"${scriptwhere}.diff\" NAME=\"diff_select\">\n";  <label for="r2" accesskey="2">and</label>
         foreach (@stickyvars) {  </td>
             printf('<INPUT TYPE=HIDDEN NAME="%s" VALUE="%s">',  $_, $input{$_})  <td class="opt-value">
                 if (defined($input{$_})  <select id="r2" name="r2">
                     && ((!defined($DEFAULTVALUE{$_})  <option value="text" selected="selected">Use Text Field</option>
                          || $input{$_} ne $DEFAULTVALUE{$_})  EOF
                         && $input{$_} ne ""));    print $sel, "</select>\n";
         }  
         print "<TABLE><TR>\n";    $diffrev = defined($input{r2}) ? $input{r2} : $revdisplayorder[0];
         print "<TD align=right>Diffs between \n";  
         print "<SELECT NAME=\"r1\">\n";    printf(<<EOF, $inputTextSize, $diffrev, $scriptwhere);
         print "<OPTION VALUE=\"text\" SELECTED>Use Text Field\n";  <input type="text" size="%s" name="tr2" value="%s" onchange="this.form.r2.selectedIndex=0" />
         print $sel;  </td>
         print "</SELECT>\n";  <td><input type="submit" value="Get Diffs" accesskey="G" /></td>
         $diffrev = $revdisplayorder[$#revdisplayorder];  </tr>
         $diffrev = $input{"r1"} if (defined($input{"r1"}));  </table>
         print "<INPUT TYPE=\"TEXT\" SIZE=\"$inputTextSize\" NAME=\"tr1\" VALUE=\"$diffrev\" onChange='document.diff_select.r1.selectedIndex=0'></TD>";  </fieldset>
         print "<TD><BR></TD></TR>\n";  </form>
         print "<TR><TD align=right>and \n";  <form method="get" action="%s">
         print "<SELECT NAME=\"r2\">\n";  <fieldset>
         print "<OPTION VALUE=\"text\" SELECTED>Use Text Field\n";  <legend>Log view options</legend>
         print $sel;  <table summary="Log view options">
         print "</SELECT>\n";  <tr>
         $diffrev = $revdisplayorder[0];  <td class="opt-label">
         $diffrev = $input{"r2"} if (defined($input{"r2"}));  <label for="f" accesskey="D">Preferred diff type:</label>
         print "<INPUT TYPE=\"TEXT\" SIZE=\"$inputTextSize\" NAME=\"tr2\" VALUE=\"$diffrev\" onChange='document.diff_select.r2.selectedIndex=0'></TD>";  </td>
         print "<TD><INPUT TYPE=SUBMIT VALUE=\"  Get Diffs  \"></TD>\n";  <td class="opt-value">
         print "</FORM>\n";  EOF
         print "</TR></TABLE>\n";    printDiffSelect();
         print "<HR noshade>\n";    print <<EOF;
         print "<TABLE>";  </td>
         print "<FORM METHOD=\"GET\" ACTION=\"$scriptwhere\">\n";  <td></td>
         print "<TR><TD align=right>Preferred Diff type:</TD>";  </tr>
         print "<TD>";  EOF
         printDiffSelect($use_java_script);  
         print "</TD><TD></TD></TR>\n";    if (@branchnames) {
         if (@branchnames) {  
             print "<TR><TD align=right>View only Branch:</TD>";      print <<EOF;
             print "<TD>";  <tr>
             print "<A name=branch></A>\n";  <td class="opt-label">
             print "<SELECT NAME=\"only_with_tag\"";  <label for="only_with_tag" accesskey="B">View only branch:</label>
             print " onchange=\"submit()\"" if ($use_java_script);  </td>
             print ">\n";  <td class="opt-value">
             print "<OPTION VALUE=\"\"";  <a name="branch">
             print " SELECTED" if (defined($input{"only_with_tag"}) &&  <select id="only_with_tag" name="only_with_tag">
                 $input{"only_with_tag"} eq "");  EOF
             print ">Show all branches\n";  
             foreach (reverse sort @branchnames) {      my @tmp = ();
                 print "<OPTION";      my $selfound = 0;
                 print " SELECTED" if (defined($input{"only_with_tag"})      foreach (reverse sort @branchnames) {
                         && $input{"only_with_tag"} eq $_);        my $selected =
                 print ">${_}\n";          (defined($input{only_with_tag}) && $input{only_with_tag} eq $_);
             }        $selfound ||= $selected;
             print "</SELECT></TD><TD></TD></TR>\n";        push(@tmp, sprintf('<option%s>%s</option>',
         }                           $selected ? ' selected="selected"' : '',
         foreach (@stickyvars) {                           htmlquote($_)));
             next if ($_ eq "f");      }
             next if ($_ eq "only_with_tag");      printf("<option value=\"\"%s>Show all branches</option>\n",
             next if ($_ eq "logsort");             $selfound ? '' : ' selected="selected"');
             print "<INPUT TYPE=HIDDEN NAME=\"$_\" VALUE=\"$input{$_}\">\n"      print join("\n", @tmp);
                 if (defined($input{$_})  
                     && (!defined($DEFAULTVALUE{$_})      print <<EOF
                         || $input{$_} ne $DEFAULTVALUE{$_})  </select>
                     && $input{$_} ne "");  </a>
         }  </td>
         print "<TR><TD align=right>";  <td></td>
         print "<A name=logsort></A>\n";  </tr>
         print "Sort log by:</TD>";  EOF
         print "<TD>";    }
         printLogSortSelect($use_java_script);  
         print "</TD>";    print <<EOF;
         print "<TD><INPUT TYPE=SUBMIT VALUE=\"  Set  \"></TD>";  <tr>
         print "</FORM>\n";  <td class="opt-label">
         print "</TR></TABLE>";  <label for="logsort" accesskey="L">Sort log by:</label>
         print &html_footer;  </td>
         print "</BODY></HTML>\n";  <td>
   EOF
     printLogSortSelect();
     print <<EOF;
   </td>
   <td><input type="submit" value="Set" accesskey="S" /></td>
   </tr>
   </table>
   EOF
     foreach (@stickyvars) {
       next if ($_ eq "f");
       next if ($_ eq "only_with_tag");
       next if ($_ eq "logsort");
       printf("<input type=\"hidden\" name=\"%s\" value=\"%s\" />\n",
              $_, htmlquote($input{$_}))
         if (defined($input{$_})
             && (!defined($DEFAULTVALUE{$_}) || $input{$_} ne $DEFAULTVALUE{$_}));
     }
     print "</fieldset>\n</form>\n";
     html_footer();
 }  }
   
 sub flush_diff_rows($$$$) {  
     my $j;  sub flush_diff_rows($$$$)
     my ($leftColRef,$rightColRef,$leftRow,$rightRow) = @_;  {
     if ($state eq "PreChangeRemove") {          # we just got remove-lines before    my ($leftColRef, $rightColRef, $leftRow, $rightRow) = @_;
       for ($j = 0 ; $j < $leftRow; $j++) {  
           print  "<tr><td bgcolor=\"$diffcolorRemove\">@$leftColRef[$j]</td>";    return unless defined($state);
           print  "<td bgcolor=\"$diffcolorEmpty\">&nbsp;</td></tr>\n";  
       }    if ($state eq "PreChangeRemove") {    # we just got remove-lines before
       for (my $j = 0; $j < $leftRow; $j++) {
         printf(<<EOF, spacedHtmlText(@$leftColRef[$j]));
   <tr>
    <td class="diff diff-removed">&nbsp;%s</td>
    <td class="diff diff-empty">&nbsp;</td>
   </tr>
   EOF
     }      }
     elsif ($state eq "PreChange") {             # state eq "PreChange"    } elsif ($state eq "PreChange") {     # state eq "PreChange"
       # we got removes with subsequent adds                                          # we got removes with subsequent adds
       for ($j = 0; $j < $leftRow || $j < $rightRow ; $j++) {  # dump out both cols        for (my $j = 0; $j < $leftRow || $j < $rightRow; $j++) { # dump both cols
           print  "<tr>";          print "<tr>\n";
           if ($j < $leftRow) {          if ($j < $leftRow) {
               print  "<td bgcolor=\"$diffcolorChange\">@$leftColRef[$j]</td>";            print '<td class="diff diff-changed">&nbsp;' .
           }              spacedHtmlText(@$leftColRef[$j]) . '</td>';
           else {          } else {
               print  "<td bgcolor=\"$diffcolorDarkChange\">&nbsp;</td>";            print '<td class="diff diff-changed-missing">&nbsp;</td>';
           }          }
           if ($j < $rightRow) {          print "\n";
               print  "<td bgcolor=\"$diffcolorChange\">@$rightColRef[$j]</td>";  
           }          if ($j < $rightRow) {
           else {            print '<td class="diff diff-changed">&nbsp;' .
               print  "<td bgcolor=\"$diffcolorDarkChange\">&nbsp;</td>";              spacedHtmlText(@$rightColRef[$j]) . '</td>';
           }          } else {
           print  "</tr>\n";            print '<td class="diff diff-changed-missing">&nbsp;</td>';
           }
           print "\n</tr>\n";
       }        }
     }    }
 }  }
   
 ##  
 # Function to generate Human readable diff-files  #
 # human_readable_diff(String revision_to_return_to);  # Generates "human readable", HTMLified diffs.
 ##  #
 sub human_readable_diff($){  sub human_readable_diff($$)
   my ($difftxt, $where_nd, $filename, $pathname, $scriptwhere_nd);  {
   my ($fh, $rev) = @_;    my ($fh, $rev) = @_;
   my ($date1, $date2, $r1d, $r2d, $r1r, $r2r, $rev1, $rev2, $sym1, $sym2);  
   my (@rightCol, @leftCol);  
   
   ($where_nd = $where) =~ s/.diff$//;    (my $where_nd       = $where)       =~ s|\.diff$||;
   ($filename = $where_nd) =~ s/^.*\///;    (my $filename       = $where_nd)    =~ s|^.*/||;
   ($pathname = $where_nd) =~ s/(Attic\/)?[^\/]*$//;    (my $pathname       = $where_nd)    =~ s|((?<=/)Attic/)?[^/]*$||;
   ($scriptwhere_nd = $scriptwhere) =~ s/.diff$//;    (my $scriptwhere_nd = $scriptwhere) =~ s|\.diff$||;
   
   navigateHeader($scriptwhere_nd, $pathname, $filename, $rev, "diff");    navigateHeader($scriptwhere_nd, $pathname, $filename, $rev, 'diff');
   
   # Read header to pick up read revision and date, if possible    # Read header to pick up read revision and date, if possible.
   
     my ($r1d, $r1r, $r2d, $r2r);
   while (<$fh>) {    while (<$fh>) {
       ($r1d,$r1r) = /\t(.*)\t(.*)$/ if (/^--- /);      ($r1d, $r1r) = /\t(.*)\t(.*)$/ if (/^--- /);
       ($r2d,$r2r) = /\t(.*)\t(.*)$/ if (/^\+\+\+ /);      ($r2d, $r2r) = /\t(.*)\t(.*)$/ if (/^\+\+\+ /);
       last if (/^\+\+\+ /);      last if (/^\+\+\+ /);
   }    }
   
     my ($rev1, $date1);
   if (defined($r1r) && $r1r =~ /^(\d+\.)+\d+$/) {    if (defined($r1r) && $r1r =~ /^(\d+\.)+\d+$/) {
     $rev1 = $r1r;      $rev1  = $r1r;
     $date1 = $r1d;      $date1 = $r1d;
   }    }
     my ($rev2, $date2);
   if (defined($r2r) && $r2r =~ /^(\d+\.)+\d+$/) {    if (defined($r2r) && $r2r =~ /^(\d+\.)+\d+$/) {
     $rev2 = $r2r;      $rev2  = $r2r;
     $date2 = $r2d;      $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) : '';
   
   print "<h3 align=center>Diff for /$where_nd between version $rev1 and $rev2</h3>\n",    my $link = uri_escape($filename) . ($query ? "$query;" : '?');
     "<table border=0 cellspacing=0 cellpadding=0 width=\"100%\">\n",  
       "<tr bgcolor=\"#ffffff\">\n",  
         "<th width=\"50%\" valign=TOP>",  
           "version $rev1";  
   print ", $date1" if (defined($date1));  
   print "<br>Tag: $sym1\n" if ($sym1);  
   print "</th>\n",  
     "<th width=\"50%\" valign=TOP>",  
       "version $rev2";  
   print ", $date2" if (defined($date2));  
   print "<br>Tag: $sym2\n" if ($sym1);  
   print "</th>\n";  
   
   my $fs = "<font face=\"$difffontface\" size=\"$difffontsize\"><tt>";    # Using <table style=\"border: none\" here breaks NS 4.x badly...
   my $fe = "</tt></font>";    print <<EOF;
   <h3 style="text-align: center">Diff for /$where_nd between versions $rev1 and $rev2</h3>
   <table border="0" cellspacing="0" cellpadding="0" width="100%" summary="Diff output">
   <tr style="background-color: #ffffff">
   <th style="text-align: center; vertical-align: top" width="50%">
   <a href="${link}rev=$rev1">version $rev1</a>$date1
   </th>
   <th style="text-align: center; vertical-align: top" width="50%">
   <a href="${link}rev=$rev2">version $rev2</a>$date2
   </th>
   </tr>
   EOF
   
   my $leftRow = 0;  
   my $rightRow = 0;  
   my ($oldline, $newline, $funname, $diffcode, $rest);  
   
   # Process diff text    # Process diff text
   # The diffrows are could make excellent use of  
   # cascading style sheets because we've to set the  
   # font and color for each row. anyone ...?  
   ####  
   
   # prefetch several lines    # prefetch several lines
   my @buf = head($fh);    my @buf = head($fh);
   
   my %d = scan_directives(@buf);    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)) {    while (@buf || !eof($fh)) {
       $difftxt = @buf ? shift @buf : <$fh>;      $difftxt = @buf ? shift @buf : <$fh>;
   
       if ($difftxt =~ /^@@/) {      if ($difftxt =~ /^@@/) {
           ($oldline,$newline,$funname) = $difftxt =~ /@@ \-([0-9]+).*\+([0-9]+).*@@(.*)/;        ($oldline, $newline, $funname) =
           $funname = htmlquote($funname);          $difftxt =~ /@@ \-([0-9]+).*\+([0-9]+).*@@(.*)/;
           print  "<tr bgcolor=\"$diffcolorHeading\"><td width=\"50%\">";        $funname = htmlquote($funname);
           print  "<table width=\"100%\" border=1 cellpadding=5><tr><td><b>Line $oldline</b>";        $funname =~ s/\s/&nbsp;/go;
           print  "&nbsp;<font size=-1>$funname</font></td></tr></table>";        $funname &&= "&nbsp;<span style=\"font-size: smaller\">$funname</span>";
           print  "</td><td width=\"50%\">";        my $ol = $oldline || 1;
           print  "<table width=\"100%\" border=1 cellpadding=5><tr><td><b>Line $newline</b>";        my $nl = $newline || 1;
           print  "&nbsp;<font size=-1>$funname</font></td></tr></table>";  
           print  "</td>\n";  
           $state = "dump";  
           $leftRow = 0;  
           $rightRow = 0;  
       }  
       else {  
           ($diffcode,$rest) = $difftxt =~ /^([-+ ])(.*)/;  
           $_ = spacedHtmlText($rest, $d{'tabstop'});  
   
           # Add fontface, size        print <<EOF;
           $_ = "$fs&nbsp;$_$fe";  <tr>
   <td width="50%" class="diff-heading">
    <b><a href="${link}rev=$rev1#l$ol">Line&nbsp;$oldline</a></b>$funname
   </td>
   <td width="50%" class="diff-heading">
    <b><a href="${link}rev=$rev2#l$nl">Line&nbsp;$newline</a></b>$funname
   </td>
   </tr>
   EOF
   
           #########        $state    = "dump";
           # little state machine to parse unified-diff output (Hen, zeller@think.de)        $leftRow  = 0;
           # in order to get some nice 'ediff'-mode output        $rightRow = 0;
           # states:      } else {
           #  "dump"             - just dump the value        my ($diffcode, $rest) = $difftxt =~ /^([-+ ])(.*)/;
           #  "PreChangeRemove"  - we began with '-' .. so this could be the start of a 'change' area or just remove        $diffcode = '' unless defined($diffcode);
           #  "PreChange"        - okey, we got several '-' lines and moved to '+' lines -> this is a change block        $_ = $rest;
           ##########  
   
           if ($diffcode eq '+') {        #########
               if ($state eq "dump") {  # 'change' never begins with '+': just dump out value        # little state machine to parse unified-diff output (Hen, zeller@think.de)
                   print  "<tr><td bgcolor=\"$diffcolorEmpty\">&nbsp;</td><td bgcolor=\"$diffcolorAdd\">$_</td></tr>\n";        # in order to get some nice 'ediff'-mode output
               }        # states:
               else {                   # we got minus before        #  "dump"             - just dump the value
                   $state = "PreChange";        #  "PreChangeRemove"  - we began with '-' .. so this could be the start of a 'change' area or just remove
                   $rightCol[$rightRow++] = $_;        #  "PreChange"        - okey, we got several '-' lines and moved to '+' lines -> this is a change block
               }        ##########
           }  
           elsif ($diffcode eq '-') {        if ($diffcode eq '+') {
               $state = "PreChangeRemove";          if ($state eq "dump")
               $leftCol[$leftRow++] = $_;          {    # 'change' never begins with '+': just dump out value
             $_ = spacedHtmlText($rest, $d{tabstop});
             printf(<<EOF, $_);
   <tr>
    <td class="diff diff-empty">&nbsp;</td>
    <td class="diff diff-added">&nbsp;%s</td>
   </tr>
   EOF
           } else {    # we got minus before
             $state = "PreChange";
             $rightCol[$rightRow++] = $_;
         }          }
         else {  # empty diffcode        } elsif ($diffcode eq '-') {
             flush_diff_rows \@leftCol, \@rightCol, $leftRow, $rightRow;          $state = "PreChangeRemove";
               print  "<tr><td>$_</td><td>$_</td></tr>\n";          $leftCol[$leftRow++] = $_;
               $state = "dump";        } else {    # empty diffcode
               $leftRow = 0;          flush_diff_rows \@leftCol, \@rightCol, $leftRow, $rightRow;
               $rightRow = 0;          $_ = spacedHtmlText($rest, $d{tabstop});
           }          printf(<<EOF, $_, $_);
   <tr>
    <td class="diff diff-same">&nbsp;%s</td>
    <td class="diff diff-same">&nbsp;%s</td>
   </tr>
   EOF
           $state    = "dump";
           $leftRow  = 0;
           $rightRow = 0;
       }        }
       }
   }    }
     close($fh);
   
   flush_diff_rows \@leftCol, \@rightCol, $leftRow, $rightRow;    flush_diff_rows \@leftCol, \@rightCol, $leftRow, $rightRow;
   
   # state is empty if we didn't have any change    # state is empty if we didn't have any change
   if (!$state) {    if (!$state) {
       print "<tr><td colspan=2>&nbsp;</td></tr>";      print <<EOF;
       print "<tr bgcolor=\"$diffcolorEmpty\" >";  <tr>
       print "<td colspan=2 align=center><b>- No viewable Change -</b></td></tr>";   <td colspan="2">&nbsp;</td>
   </tr>
   <tr class="diff diff-empty">
    <td colspan="2" align="center"><b>- No viewable change -</b></td>
   </tr>
   EOF
   }    }
   print  "</table>";  
   close($fh);  
   
   print "<br><hr noshade width=\"100%\">\n";    printf(<<EOF, $scriptwhere);
   </table>
   <hr style="width: 100%%" />
   <form method="get" action="%s">
   <div style="float: left">
   <label for="f">Diff format:<br />
   EOF
     printDiffSelectStickyVars();
     printDiffSelect();
     printf(<<EOF, $rev1, $rev2);
   </label>
   <input type="submit" value="Show" />
   </div>
   <table style="float: right; border: thin outset" cellspacing="0" cellpadding="1" title="Legend" summary="Legend">
    <tr>
     <td align="center" class="diff diff-removed">Removed from v.%s</td>
     <td class="diff diff-empty">&nbsp;</td>
    </tr><tr class="diff diff-changed">
     <td align="center" colspan="2">changed lines</td>
    </tr><tr>
     <td class="diff diff-empty">&nbsp;</td>
     <td align="center" class="diff diff-added">Added in v.%s</td>
    </tr>
   </table>
   </form>
   <br clear="all" />
   EOF
   }
   
   print "<table border=0>";  
   
   print "<tr><td>";  #
   # print legend  # The passed in $path and $filename should not be URI escaped, and $swhere
   print "<table border=1><tr><td>";  # *should* be.
   print  "Legend:<br><table border=0 cellspacing=0 cellpadding=1>\n";  #
   print  "<tr><td align=center bgcolor=\"$diffcolorRemove\">Removed from v.$rev1</td><td bgcolor=\"$diffcolorEmpty\">&nbsp;</td></tr>";  sub navigateHeader($$$$$;$)
   print  "<tr bgcolor=\"$diffcolorChange\"><td align=center colspan=2>changed lines</td></tr>";  {
   print  "<tr><td bgcolor=\"$diffcolorEmpty\">&nbsp;</td><td align=center bgcolor=\"$diffcolorAdd\">Added in v.$rev2</td></tr>";    my ($swhere, $path, $filename, $rev, $title, $moddate) = @_;
   print  "</table></td></tr></table>\n";    $swhere = "" if ($swhere eq $scriptwhere);
     $swhere = './' . uri_escape($filename) if ($swhere eq "");
   
   print "<td>";    my $qfile = htmlquote($filename);
   # Print format selector    my $qpath = htmlquote($path);
   print "<FORM METHOD=\"GET\" ACTION=\"${scriptwhere}\">\n";    my $trev  = $rev ? " - " . htmlquote($rev) : '';
   foreach my $var (keys %input) {  
     next if ($var eq "f");  
     next if (defined($DEFAULTVALUE{$var})  
              && $DEFAULTVALUE{$var} eq $input{$var});  
     print "<INPUT TYPE=HIDDEN NAME=\"",urlencode($var),"\" VALUE=\"",  
             urlencode($input{$var}),"\">\n";  
   }  
   printDiffSelect($use_java_script);  
   print "<INPUT TYPE=SUBMIT VALUE=\"Show\">\n";  
   print "</FORM>\n";  
   print "</td>";  
   
   print "</tr></table>";    http_header('text/html', $moddate);
 }  
   
 sub navigateHeader($$$$$) {    print <<EOF;
     my ($swhere,$path,$filename,$rev,$title) = @_;  $HTML_DOCTYPE
     $swhere = "" if ($swhere eq $scriptwhere);  <html>
     $swhere = './' . urlencode($filename) if ($swhere eq "");  <head>
   <title>$qpath$qfile - $title$trev</title>
     print <<EOF;  $HTML_META$CSS</head>
 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">  <body class="src">
 <HTML>  <table class="navigate-header" width="100%" summary="Navigation">
 <HEAD>   <tr>
 <META name="robots" content="nofollow">    <td>
 <!-- knu-cvsweb $cvsweb_revision -->  
 <TITLE>$path$filename - $title - $rev</TITLE></HEAD>  
 $body_tag_for_src  
 <table width="100%" border=0 cellspacing=0 cellpadding=1 bgcolor="$navigationHeaderColor">  
 <tr valign=bottom><td>  
 EOF  EOF
   
     print &link($backicon, "$swhere$query#rev$rev");    my $frag = '';
     print "<b>Return to ", &link($filename,"$swhere$query#rev$rev")," CVS log";    if ($rev) {
     print "</b> $fileicon</td>";      $frag  = '#';
       $frag .= 'rev' if ($rev =~ /\./);  # Normal revision: prefix with "rev".
       $frag .= $rev;                     # Append revision/branch/tag.
     }
     my $backurl = "$swhere$query$frag";
   
     print "<td align=right>$diricon <b>Up to ", &clickablePath($path, 1), "</b></td>";    print &link($backicon, $backurl);
     print "</tr></table>";    printf '<b>Return to %s CVS log', &link($qfile, $backurl);
     print "</b> $fileicon</td>";
   
     printf(<<EOF, $diricon, &clickablePath($path, 1));
     <td style="text-align: right">%s <b>Up to %s</b></td>
    </tr>
   </table>
   EOF
 }  }
   
 sub plural_write($$) {  
     my ($num,$text) = @_;  sub plural_write($$)
     if ($num != 1) {  {
         $text .= "s";    my ($num, $text) = @_;
     }    if ($num != 1) {
     if ($num > 0) {      $text .= "s";
         return join(' ', $num, $text);    }
     }  
     else {    if ($num > 0) {
         return "";      return join (' ', $num, $text);
     }    } else {
       return "";
     }
 }  }
   
   
 ##  ##
 # print readable timestamp in terms of  # print readable timestamp in terms of
 # '..time ago'  # '..time ago'
 # H. Zeller <zeller@think.de>  # H. Zeller <zeller@think.de>
 ##  ##
 sub readableTime($$) {  sub readableTime($$)
     my ($i, $break, $retval);  {
     my ($secs,$long) = @_;    my ($secs, $long) = @_;
   
     # this function works correct for time >= 2 seconds    # This function works correctly for time >= 2 seconds.
     if ($secs < 2) {    return 'very little time' if ($secs < 2);
         return "very little time";  
     }  
   
     my %desc = (1 , 'second',    my %desc = (
                    60, 'minute',                1        => 'second',
                    3600, 'hour',                60       => 'minute',
                    86400, 'day',                3600     => 'hour',
                    604800, 'week',                86400    => 'day',
                    2628000, 'month',                604800   => 'week',
                    31536000, 'year');                2628000  => 'month',
     my @breaks = sort {$a <=> $b} keys %desc;                31536000 => 'year'
     $i = 0;               );
     while ($i <= $#breaks && $secs >= 2 * $breaks[$i]) {  
         $i++;    my @breaks = sort { $a <=> $b } keys %desc;
     }    my $i = 0;
   
     while ($i <= $#breaks && $secs >= 2 * $breaks[$i]) {
       $i++;
     }
     $i--;
     my $break  = $breaks[$i];
     my $retval = plural_write(int($secs / $break), $desc{$break});
   
     if ($long == 1 && $i > 0) {
       my $rest = $secs % $break;
     $i--;      $i--;
     $break = $breaks[$i];      $break = $breaks[$i];
     $retval = plural_write(int ($secs / $break), $desc{$break});      my $resttime = plural_write(int($rest / $break), $desc{$break});
       if ($resttime) {
     if ($long == 1 && $i > 0) {        $retval .= ", $resttime";
         my $rest = $secs % $break;  
         $i--;  
         $break = $breaks[$i];  
         my $resttime = plural_write(int ($rest / $break),  
                                 $desc{$break});  
         if ($resttime) {  
             $retval .= ", $resttime";  
         }  
     }      }
     }
   
     return $retval;    return $retval;
 }  }
   
 ##  
 # clickablePath(String pathname, boolean last_item_clickable)  
 #  #
 # returns a html-ified path whereas each directory is a link for  # Returns a htmlified path where each directory is a link for faster
 # faster navigation. last_item_clickable controls whether the  # navigation.  $clickLast controls whether the basename
 # basename (last directory/file) is a link as well  # (last directory/file) is a link as well.  The passed in $pathname should
 ##  # *not* be URI escaped.
 sub clickablePath($$) {  #
     my ($pathname,$clickLast) = @_;  sub clickablePath($$)
     my $retval = '';  {
     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|/$|;  
         foreach (split(/\//, $pathname)) {  
             $retval .= " / ";  
             $wherepath .= "/$_";  
             my ($last) = "$wherepath/" eq "/$pathname"  
                 || $wherepath eq "/$pathname";  
             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;  
 }  
   
 sub chooseCVSRoot() {    # This should never happen (see chooseCVSRoot()), but let's be sure...
     if (2 <= @CVSROOT) {    return $root if ($pathname eq '/');
         my ($k);  
         print "<form method=\"GET\" action=\"${scriptwhere}\">\n";  
         foreach $k (keys %input) {  
             print "<input type=hidden NAME=$k VALUE=$input{$k}>\n"  
                 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 "<table><tr>";  
         print "<td>CVS Root:</td>";  
         print "<td>\n<select name=\"cvsroot\"";  
         print " onchange=\"submit()\"" if ($use_java_script);  
         print ">\n";  
         foreach $k (@CVSROOT) {  
             print "<option value=\"$k\"";  
             print " selected" if ($k eq $cvstree);  
             print ">", ($CVSROOTdescr{$k} ? $CVSROOTdescr{$k} : $k), "</option>\n";  
         }  
         print "</select>\n</td>";  
         print "<td>";  
     }  
     else {  
         # no choice ..  
         print "CVS Root: <b>[$cvstree]</b>";  
     }  
   
     print " Module path or alias:\n";    my $retval =
     print "<INPUT TYPE=TEXT NAME=\"path\" VALUE=\"\" SIZE=15>\n";      ' ' . &link($root, sprintf('%s/%s#dirlist', $scriptname, $query));
     print "<input type=submit value=\"Go\">";    my $wherepath = '';
     my ($lastslash) = $pathname =~ m|/$|;
   
     if (2 <= @CVSROOT) {    foreach (split(m|/|, $pathname)) {
         print "</td></tr></table></form>";      $retval .= ' / ';
     }      $wherepath .= "/$_";
 }      my $last = "$wherepath/" eq "/$pathname" || $wherepath eq "/$pathname";
   
 sub chooseMirror() {      if ($clickLast || !$last) {
     my ($mirror,$moremirrors);        $retval .= &link(htmlquote($_),
     $moremirrors = 0;                         join ('',
     # This code comes from the original BSD-cvsweb                               $scriptname, uri_escape_path($wherepath),
     # and may not be useful for your site; If you don't                               (!$last || $lastslash ? '/' : ''), $query,
     # set %MIRRORS this won't show up, anyway                               (!$last || $lastslash ? "#dirlist" : "")));
     #      } else {    # do not make a link to the current dir
     # Should perhaps exlude the current site somehow..        $retval .= htmlquote($_);
     if (keys %MIRRORS) {  
         print "\nThis cvsweb is mirrored in:\n";  
         foreach $mirror (keys %MIRRORS) {  
             print ", " if ($moremirrors);  
             print &link(htmlquote($mirror),$MIRRORS{$mirror});  
             $moremirrors = 1;  
         }  
         print "<p>\n";  
     }      }
     }
     return $retval;
 }  }
   
 sub fileSortCmp() {  
     my ($comp) = 0;  
     my ($c,$d,$af,$bf);  
   
     ($af = $a) =~ s/,v$//;  sub chooseCVSRoot()
     ($bf = $b) =~ s/,v$//;  {
     my ($rev1,$date1,$log1,$author1,$filename1) = @{$fileinfo{$af}}    print "<form method=\"get\" action=\"$scriptwhere\">\n<p>\n";
         if (defined($fileinfo{$af}));    if (2 <= @CVSROOT) {
     my ($rev2,$date2,$log2,$author2,$filename2) = @{$fileinfo{$bf}}      foreach my $k (keys %input) {
         if (defined($fileinfo{$bf}));        printf("<input type=\"hidden\" name=\"%s\" value=\"%s\" />\n",
                htmlquote($k), htmlquote($input{$k}))
           if ($input{$k} && $k ne 'cvsroot');
       }
   
     if (defined($filename1) && defined($filename2) && $af eq $filename1 && $bf eq $filename2) {      print <<EOF;
         # Two files  <label for="cvsroot" accesskey="C">CVS Root:
         $comp = -revcmp($rev1, $rev2) if ($byrev && $rev1 && $rev2);  <select id="cvsroot" name="cvsroot">
         $comp = ($date2 <=> $date1) if ($bydate && $date1 && $date2);  EOF
         $comp = ($log1 cmp $log2) if ($bylog && $log1 && $log2);  
         $comp = ($author1 cmp $author2) if ($byauthor && $author1 && $author2);      foreach my $k (@CVSROOT) {
         printf("<option value=\"%s\"%s>%s</option>\n",
                htmlquote($k),
                ($k eq $cvstree) ? ' selected="selected"' : '',
                htmlquote($CVSROOTdescr{$k} || $k));
     }      }
     if ($comp == 0) {      print '</select></label>';
         # Directories first, then sorted on name if no other sort critera    } else {
         # available.  
         my $ad = ((-d "$fullname/$a")?"D":"F");      # no choice -- but we need the form to select module/path,
         my $bd = ((-d "$fullname/$b")?"D":"F");      # at least for Netscape
         ($c=$a) =~ s|.*/||;      printf "CVS Root: <b>[%s]</b>",
         ($d=$b) =~ s|.*/||;        htmlquote($CVSROOTdescr{$cvstree} || $cvstree);
         $comp = ("$ad$c" cmp "$bd$d");    }
     }  
     return $comp;    print <<EOF;
   <label for="mpath" accesskey="M">
   Module path or alias:
   <input type="text" id="mpath" name="path" value="" size="15" />
   </label>
   <input type="submit" value="Go" accesskey="O" />
   </p>
   </form>
   EOF
 }  }
   
 # make A url for downloading  
 sub download_url($$;$) {  
     my ($url,$revision,$mimetype) = @_;  
   
     $revision =~ s/\b0\.//;  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;
   
     if (defined($checkoutMagic)    # Should perhaps exclude the current site somehow...
         && (!defined($mimetype) || $mimetype ne "text/x-cvsweb-markup")) {    print "\n<p>\nThis CVSweb is mirrored in\n";
         my $path = $where;  
         $path =~ s|/[^/]*$|/|;  
         $url = "$scriptname/$checkoutMagic/${path}$url";  
     }  
     $url .= "?rev=$revision";  
     $url .= '&content-type=' . urlencode($mimetype) if (defined($mimetype));  
   
     $url;    my @tmp = map(&link(htmlquote($_), $MIRRORS{$_}), sort keys %MIRRORS);
     my $tmp = pop (@tmp);
   
     if (scalar(@tmp)) {
       print join (', ', @tmp), ' and ';
     }
   
     print "$tmp.\n</p>\n";
 }  }
   
 # Presents a link to download the  
 # selected revision  
 sub download_link($$$;$) {  
     my ($url, $revision, $textlink, $mimetype) = @_;  
     my ($fullurl) = download_url($url, $revision, $mimetype);  
   
     $fullurl =~ s/:/sprintf("%%%02x", ord($&))/eg;  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}));
   
     printf '<A HREF="%s"', hrefquote("$fullurl$barequery");    my $comp = 0;
     if (defined($filename1) && defined($filename2) &&
         $af eq $filename1   && $bf eq $filename2)
     {
   
     if ($open_extern_window && (!defined($mimetype) || $mimetype ne "text/x-cvsweb-markup")) {      # Two files
         print ' target="cvs_checkout"';      $comp = -revcmp($rev1, $rev2)             if ($byrev  && $rev1  && $rev2);
         # we should have      $comp = ($date2   <=> $date1)             if ($bydate && $date1 && $date2);
         #   'if (document.cvswin==null) document.cvswin=window.open(...'      if ($input{ignorecase}) {
         # in order to allow the user to resize the window; otherwise        $comp = (uc($log1)    cmp uc($log2))    if ($bylog && $log1 && $log2);
         # the user may resize the window, but on next checkout - zap -        $comp = (uc($author1) cmp uc($author2)) if ($byauthor &&
         # its original (configured s. cvsweb.conf) size is back again                                                    $author1 && $author2);
         # .. annoying (if $extern_window_(width|height) is defined)      } else {
         # but this if (..) solution is far from perfect        $comp = ($log1    cmp $log2)            if ($bylog && $log1 && $log2);
         # what we need to do as well is        $comp = ($author1 cmp $author2)         if ($byauthor &&
         # 1) save cvswin in an invisible frame that always exists                                                    $author1 && $author2);
         #    (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(resizeable scrollbars);  
   
             push @attr, qw(status toolbar)    if ($comp == 0) {
               if (defined($mimetype) && $mimetype eq "text/html");  
   
             push @attr, "width=$extern_window_width"      # Directories first, then files under version control,
               if (defined($extern_window_width));      # then other, "rogue" files.
       # Sort by filename if no other criteria available.
   
             push @attr, "height=$extern_window_height"      my $ad = (
               if (defined($extern_window_height));        (-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|.*/||;
   
             printf q` onClick="window.open('%s','cvs_checkout','%s');"`,      my ($l, $r) = ("$ad$c", "$bd$d");
               hrefquote($fullurl), join(',', @attr);      $comp = $input{ignorecase} ? (uc($l) cmp uc($r)) : ($l cmp $r);
         }  
     }  
     print "><b>$textlink</b></A>";  
 }  
   
 # Returns a Query string with the      # Parent dir is always first, then Attic.
 # specified parameter toggled      if ($comp != 0) {
 sub toggleQuery($$) {        if ($l eq 'D..') {
     my ($toggle,$value) = @_;          $comp = -1;
     my ($newquery,$var);        } elsif ($r eq 'D..') {
     my (%vars);          $comp = 1;
     %vars = %input;        } elsif ($l eq 'DAttic') {
     if (defined($value)) {          $comp = -1;
         $vars{$toggle} = $value;        } elsif ($r eq 'DAttic') {
           $comp = 1;
         }
     }      }
     else {    }
         $vars{$toggle} = $vars{$toggle} ? 0 : 1;    return $comp;
     }  
     # 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 ($value ne $default) {  
             $newquery .= "&" if ($newquery ne "");  
             $newquery .= urlencode($var) . "=" . urlencode($value);  
         }  
     }  
     if ($newquery) {  
         return '?' . $newquery;  
     }  
     return "";  
 }  }
   
 sub urlencode($) {  #
     local($_) = @_;  # 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);
   
     s/[\000-+{-\377]/sprintf("%%%02x", ord($&))/ge;    if (!defined($mimetype) || $mimetype !~ CVSWEBMARKUP) {
       my $path = $where;
       $path =~ s|[^/]+$||;
       $url = "$scriptname/$CheckoutMagic/$path$url";
     }
     $url .= '?rev=' . uri_escape($revision);
     $url .= ';content-type=' . uri_escape($mimetype) if $mimetype;
   
     $_;    return $url;
 }  }
   
 sub htmlquote($) {  #
     local($_) = @_;  # 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('<a href="%s" class="download-link">%s</a>',
                    download_url($url, $revision, $mimetype) . $barequery,
                    htmlquote($textlink));
   }
   
     # Special Characters; RFC 1866  #
     s/&/&amp;/g;  # Returns a URL to display the selected revision.
     s/\"/&quot;/g;  # Expects the passed in URL to be URI escaped, and without a query string.
     s/</&lt;/g;  #
     s/>/&gt;/g;  sub display_url($$;$)
   {
     my ($url, $revision, $mimetype) = @_;
     $url .= '?rev=' . uri_escape($revision);
     $url .= ';content-type=' . uri_escape($mimetype) if $mimetype;
     return $url;
   }
   
     $_;  #
   # Returns a link to display the selected revision.
   # Expects the passed in URL to be URI escaped, and without a query string.
   #
   sub display_link($$;$$)
   {
     my ($url, $revision, $textlink, $mtype) = @_;
     $textlink = $revision unless defined($textlink);
     return sprintf('<a href="%s" class="display-link">%s</a>',
                    display_url($url, $revision, $mtype) . $barequery,
                    htmlquote($textlink));
 }  }
   
 sub htmlunquote($) {  #
     local($_) = @_;  # 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)));
   }
   
     # Special Characters; RFC 1866  # Returns a Query string with the
     s/&quot;/\"/g;  # specified parameter toggled
     s/&lt;/</g;  sub toggleQuery($;$)
     s/&gt;/>/g;  {
     s/&amp;/&/g;    my ($toggle, $value) = @_;
   
     $_;    my %vars = %input;
   
     if (defined($value)) {
       $vars{$toggle} = $value;
     } else {
       $vars{$toggle} = $vars{$toggle} ? 0 : 1;
     }
   
     # Build a new query of non-default paramenters
     my $newquery = "";
     foreach my $var (@stickyvars) {
       my ($value)   = defined($vars{$var})         ? $vars{$var}         : "";
       my ($default) = defined($DEFAULTVALUE{$var}) ? $DEFAULTVALUE{$var} : "";
   
       if ($value ne $default) {
         $newquery .= ';' if ($newquery ne "");
         $newquery .= uri_escape($var) . '=' . uri_escape($value);
       }
     }
   
     if ($newquery) {
       return '?' . $newquery;
     }
     return "";
 }  }
   
 sub hrefquote($) {  sub htmlquote($)
     local($_) = @_;  {
     local ($_) = @_;
     # Special Characters; RFC 1866
     s/&/&amp;/g;
     s/\"/&quot;/g;
     s/"/&quot;/g;
     s/</&lt;/g;
     s/>/&gt;/g;
     return $_;
   }
   
     y/ /+/;  sub htmlunquote($)
   {
     local ($_) = @_;
     # Special Characters; RFC 1866
     s/&quot;/\"/g;
     s/&lt;/</g;
     s/&gt;/>/g;
     s/&amp;/&/g;
     return $_;
   }
   
     htmlquote($_)  sub uri_escape_path($)
   {
     return join('/', map(uri_escape($_), split(m|/+|, shift, -1)));
 }  }
   
 sub http_header(;$) {  sub http_header(;$$)
     my $content_type = shift || "text/html";  {
     my ($content_type, $moddate) = @_;
     $content_type ||= 'text/html';
   
     $content_type .= "; charset=$charset"    $content_type .= "; charset=$charset"
       if $content_type =~ m,^text/, && defined($charset) && $charset;      if ($charset && $content_type =~ m,^text/,);
   
     if (defined($moddate)) {    # Note that in the following, we explicitly join() and concatenate the
         if ($is_mod_perl) {    # headers instead of printing them as an array.  This is because some
             Apache->request->header_out("Last-Modified" => scalar gmtime($moddate) . " GMT");    # 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().
         else {  
             print "Last-Modified: ", scalar gmtime($moddate), " GMT\r\n";    my @headers = ();
         }    # TODO: ctime(3) from scalar gmtime() isn't HTTP compliant, see HTTP::Date.
     }    push(@headers, 'Last-Modified: ' . scalar gmtime($moddate) . ' GMT')
     if ($is_mod_perl) {      if $moddate;
         Apache->request->content_type($content_type);    push(@headers, 'Content-Type: ' . $content_type);
     }    push(@headers, "Content-Security-Policy: default-src 'none'; " .
     else {      "img-src 'self'; style-src 'unsafe-inline'");
             print "Content-type: $content_type\r\n";  
     }    if ($allow_compress && $maycompress) {
     if ($allow_compress && $maycompress) {        push(@headers, 'Content-Encoding: gzip');
         if ($has_zlib || (defined($CMD{gzip}) && open(GZIP, "| $CMD{gzip} -1 -c"))) {        push(@headers, 'Vary: Accept-Encoding');     # RFC 2616, 14.44
             if ($is_mod_perl) {        print join("\r\n", @headers) . "\r\n\r\n";
                     Apache->request->content_encoding("x-gzip");  
                     Apache->request->header_out(Vary => "Accept-Encoding");        $| = 1;
                     Apache->request->send_http_header;        $| = 0;                                      # Flush header output.
             }  
             else {        tie(*GZIP, __PACKAGE__, \*STDOUT);
                     print "Content-encoding: x-gzip\r\n";        select(GZIP);
                     print "Vary: Accept-Encoding\r\n";  #RFC 2068, 14.43        $gzip_open = 1;
                     print "\r\n"; # Close headers    } else {
             }      print join("\r\n", @headers) . "\r\n\r\n";
             $| = 1; $| = 0; # Flush header output    }
             if ($has_zlib) {  
                 tie *GZIP, __PACKAGE__, \*STDOUT;  
             }  
             select(GZIP);  
             $gzip_open = 1;  
 #           print "<!-- gzipped -->" if ($content_type =~ m|^text/html\b|);  
         }  
         else {  
             if ($is_mod_perl) {  
                     Apache->request->send_http_header;  
             }  
             else {  
                     print "\r\n"; # Close headers  
             }  
             print "<font size=-1>Unable to find gzip binary in the <b>\$command_path</b> ($command_path) to compress output</font><br>";  
         }  
     }  
     else {  
             if ($is_mod_perl) {  
                     Apache->request->send_http_header;  
             }  
             else {  
                     print "\r\n"; # Close headers  
             }  
     }  
 }  }
   
 sub html_header($) {  
     my ($title) = @_;  sub html_header($;$)
     http_header("text/html");  {
     print <<EOH;    my ($title, $moddate) = @_;
 <!doctype html public "-//W3C//DTD HTML 4.0 Transitional//EN"    $title  = htmlquote($title);
  "http://www.w3.org/TR/REC-html40/loose.dtd">    my $l   = $logo || '';
     my $css = $CSS || '';
     http_header('text/html', $moddate);
     print <<EOH;
   $HTML_DOCTYPE
 <html>  <html>
 <head>  <head>
 <meta name="robots" content="nofollow">  
 <title>$title</title>  <title>$title</title>
 <!-- knu-cvsweb $cvsweb_revision -->  $HTML_META$css</head>
 </head>  <body>
 $body_tag  $l <h1>$title</h1>
 $logo <h1 align="center">$title</h1>  
 EOH  EOH
 }  }
   
 sub html_footer() {  sub html_footer()
     return "<hr noshade><address>$address</address>\n";  {
     print "<hr />\n<address>$address</address>\n" if $address;
     print "</body>\n</html>\n";
 }  }
   
 sub link_tags($) {  sub link_tags($)
     my ($tags) = @_;  {
     my ($ret) = "";    my ($tags) = @_;
     my ($fileurl,$filename);  
   
     ($filename = $where) =~ s/^.*\///;    (my $filename = $where) =~ s|^.*/||;
     $fileurl = './' . urlencode($filename);    my $fileurl = './' . uri_escape($filename);
   
     foreach my $sym (split(", ", $tags)) {    my $ret = "";
         $ret .= ",\n" if ($ret ne "");    foreach my $sym (split(", ", $tags)) {
         $ret .= &link($sym, $fileurl . toggleQuery('only_with_tag',$sym));      $ret .= ",\n" if ($ret ne "");
     }      $ret .= &link(htmlquote($sym),
     return "$ret\n";                    $fileurl . toggleQuery('only_with_tag', $sym));
     }
     return $ret;
 }  }
   
   
 #  #
 # See if a module is listed in the config file's @HideModule list.  # 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_module($) {  sub forbidden($)
     my($module) = @_;  {
     (my $path = canonpath(shift)) =~ s/,v$//;
     $path =~ s|^$cvsroot/+||;
     for my $forbidden_re (@ForbiddenFiles) {
       return 1 if ($path =~ $forbidden_re);
     }
     return 0;
   }
   
     for (my $i=0; $i < @HideModules; $i++) {  
         return 1 if $module eq $HideModules[$i];  
     }  
   
     return 0;  #
   # Starts a process using IPC::Run.  All arguments are passed to
   # IPC::Run::start() as-is.  Returns an array ($harness, $error) where
   # $harness is from IPC::Run if start() succeeds, undef otherwise.  In case
   # of an error, $error contains the error message.
   #
   sub startproc(@)
   {
     my $h = my $err = undef;
     eval {
       local $SIG{__DIE__};
       $h = IPC::Run::start(@_) or die("return code: $?");
     };
     if ($@) {
       $h->finish() if $h;
       $h = undef;
       $err = "'@{$_[0]}' failed: $@";
     }
     return ($h, $err);
 }  }
   
 # Close the GZIP handle remove the tie.  #
   # Runs a process using IPC::Run.  All arguments are passed to
   # IPC::Run::run() as-is.  Returns an array ($exitcode, $errormsg).
   #
   sub runproc(@)
   {
     eval {
       local $SIG{__DIE__};
       IPC::Run::run(@_);
     };
     my $exitcode = $? >> 8;
     my $errormsg  = undef;
     if ($@) {
       $exitcode ||= -1;
       $errormsg = "'@{$_[0]}' failed: $@";
     }
     return ($exitcode, $errormsg);
   }
   
 sub gzipclose {  #
         if ($gzip_open) {  # Check out a file to a temporary file.
             select(STDOUT);  #
             close(GZIP);  sub checkout_to_temp($$$)
             untie *GZIP;  {
             $gzip_open = 0;    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 <DIFF_OUT>;
       $h->finish();
       close($temp_fh);
     } else {
       close($temp_fh);
       unlink($temp_fn);
       fatal('500 Internal Error',
             'Checkout failure (exit status %s), output: <pre>%s</pre>',
             $? >> 8 || -1, $err);
     }
   
     return $temp_fn;
 }  }
   
   #
   # Close the GZIP handle, and remove the tie.
   #
   sub gzipclose
   {
     if ($gzip_open) {
       select(STDOUT);
       close(GZIP);
       untie *GZIP;
       $gzip_open = 0;
     }
   }
   
 # implement a gzipped file handle via the Compress:Zlib compression  # implement a gzipped file handle via the Compress:Zlib compression
 # library.  # library.
   
 sub MAGIC1() { 0x1f }  sub MAGIC1() { 0x1f }
 sub MAGIC2() { 0x8b }  sub MAGIC2() { 0x8b }
 sub OSCODE() { 3    }  sub OSCODE() { 3 }
   
 sub TIEHANDLE {  sub TIEHANDLE
         my ($class, $out) = @_;  {
         my ($d) = Compress::Zlib::deflateInit(-Level => Compress::Zlib::Z_BEST_COMPRESSION(),    my ($class, $out) = @_;
                 -WindowBits => -Compress::Zlib::MAX_WBITS()) or return undef;    my ($d) = Compress::Zlib::deflateInit(
         my ($o) = {      -Level      => Compress::Zlib::Z_BEST_COMPRESSION(),
                 handle => $out,      -WindowBits => -Compress::Zlib::MAX_WBITS()
                 dh => $d,      )
                 crc => 0,      or return undef;
                 len => 0,    my ($o) = { handle => $out,
         };                dh     => $d,
         my ($header) = pack("c10", MAGIC1, MAGIC2, Compress::Zlib::Z_DEFLATED(), 0,0,0,0,0,0, OSCODE);                crc    => 0,
         print {$o->{handle}} $header;                len    => 0,
         return bless($o, $class);              };
     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 {  sub PRINT
         my ($o) = shift;  {
         my ($buf) = join(defined $, ? $, : "",@_);    my ($o)   = shift;
         my ($len) = length($buf);    my ($buf) = join (defined($,) ? $, : "", @_);
         my ($compressed, $status) = $o->{dh}->deflate($buf);    my ($len) = length($buf);
         print {$o->{handle}} $compressed if defined($compressed);    my ($compressed, $status) = $o->{dh}->deflate($buf);
         $o->{crc} = Compress::Zlib::crc32($buf, $o->{crc});    print {$o->{handle}} $compressed if defined($compressed);
         $o->{len} += $len;    $o->{crc} = Compress::Zlib::crc32($buf, $o->{crc});
         return $len;    $o->{len} += $len;
     return $len;
 }  }
   
 sub PRINTF {  sub PRINTF
         my ($o) = shift;  {
         my ($fmt) = shift;    my ($o)   = shift;
         my ($buf) = sprintf($fmt, @_);    my ($fmt) = shift;
         my ($len) = length($buf);    my ($buf) = sprintf($fmt, @_);
         my ($compressed, $status) = $o->{dh}->deflate($buf);    my ($len) = length($buf);
         print {$o->{handle}} $compressed if defined($compressed);    my ($compressed, $status) = $o->{dh}->deflate($buf);
         $o->{crc} = Compress::Zlib::crc32($buf, $o->{crc});    print {$o->{handle}} $compressed if defined($compressed);
         $o->{len} += $len;    $o->{crc} = Compress::Zlib::crc32($buf, $o->{crc});
         return $len;    $o->{len} += $len;
     return $len;
 }  }
   
 sub WRITE {  sub WRITE
         my ($o, $buf, $len, $off) = @_;  {
         my ($compressed, $status) = $o->{dh}->deflate(substr($buf, 0, $len));    my ($o, $buf, $len, $off) = @_;
         print {$o->{handle}} $compressed if defined($compressed);    my ($compressed, $status) = $o->{dh}->deflate(substr($buf, 0, $len));
         $o->{crc} = Compress::Zlib::crc32(substr($buf, 0, $len), $o->{crc});    print {$o->{handle}} $compressed if defined($compressed);
         $o->{len} += $len;    $o->{crc} = Compress::Zlib::crc32(substr($buf, 0, $len), $o->{crc});
         return $len;    $o->{len} += $len;
     return $len;
 }  }
   
 sub CLOSE {  sub CLOSE
         my ($o) = @_;  {
         return if !defined( $o->{dh});    my ($o) = @_;
         my ($buf) = $o->{dh}->flush();    return if !defined($o->{dh});
         $buf .= pack("V V", $o->{crc}, $o->{len});    my ($buf) = $o->{dh}->flush();
         print {$o->{handle}} $buf;    $buf .= pack("V V", $o->{crc}, $o->{len});
         undef $o->{dh};    print {$o->{handle}} $buf;
     undef $o->{dh};
 }  }
   
 sub DESTROY {  sub DESTROY
         my ($o) = @_;  {
         CLOSE($o);    my ($o) = @_;
     CLOSE($o);
 }  }
   
   # Local variables:
   # indent-tabs-mode: nil
   # cperl-indent-level: 2
   # End:

Legend:
Removed from v.1.1.1.27  
changed lines
  Added in v.4.19

CVSweb