[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.36 and 1.1.1.37

version 1.1.1.36, 2002/09/30 19:48:52 version 1.1.1.37, 2007/03/17 21:52:33
Line 1 
Line 1 
 #!/usr/bin/perl -wT  #!/usr/bin/perl -T
 #  #
 # cvsweb - a CGI interface to CVS trees.  # cvsweb - a CGI interface to CVS trees.
 #  #
Line 21 
Line 21 
 #           (c) 1998-1999 Henner Zeller  #           (c) 1998-1999 Henner Zeller
 #           (c) 1999      Henrik Nordstrom  #           (c) 1999      Henrik Nordstrom
 #           (c) 2000-2002 Akinori MUSHA  #           (c) 2000-2002 Akinori MUSHA
 #           (c) 2002      Ville Skyttä  #           (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 45 
Line 45 
 # 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.
 #  #
 # $FreeBSD: projects/cvsweb/cvsweb.cgi,v 1.119.2.6 2002/09/26 20:56:05 scop Exp $  # $FreeBSD: projects/cvsweb/cvsweb.cgi,v 1.295 2005/09/25 20:28:51 scop Exp $
 # $zId: cvsweb.cgi,v 1.112 2001/07/24 13:03:16 hzeller Exp $  # $zId: cvsweb.cgi,v 1.112 2001/07/24 13:03:16 hzeller Exp $
 # $Idaemons: /home/cvs/cvsweb/cvsweb.cgi,v 1.84 2001/10/07 20:50:10 knu Exp $  # $Idaemons: /home/cvs/cvsweb/cvsweb.cgi,v 1.84 2001/10/07 20:50:10 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    $where $Browser $nofilelinks $maycompress @stickyvars %funcline_regexp
     @stickyvars @unsafevars    $is_links $is_lynx $is_w3m $is_msie $is_mozilla3 $is_textbased
     %funcline_regexp $is_mod_perl    %input $query $barequery $sortby $bydate $byrev $byauthor
     $is_links $is_lynx $is_w3m $is_msie $is_mozilla3 $is_textbased    $bylog $byfile $defaultDiffType $logsort $cvstree $cvsroot
     %input $query $barequery $sortby $bydate $byrev $byauthor    $charset $output_filter
     $bylog $byfile $defaultDiffType $logsort $cvstree $cvsroot    @command_path %CMD $allow_compress $backicon $diricon $fileicon $graphicon
     $mimetype $charset $output_filter $defaultTextPlain $defaultViewable    $fullname $cvstreedefault $logo $defaulttitle $address $binfileicon
     $command_path %CMD $allow_compress    $long_intro $short_instruction $shortLogLen $show_author
     $backicon $diricon $fileicon    $tablepadding $hr_breakable $showfunc $hr_ignwhite $hr_ignkeysubst
     $fullname $newname $cvstreedefault    $inputTextSize $mime_types $allow_annotate $allow_markup $allow_mailtos
     $body_tag $body_tag_for_src $logo $defaulttitle $address    $allow_log_extra $allow_dir_extra $allow_source_extra
     $long_intro $short_instruction $shortLogLen    $allow_cvsgraph $cvsgraph_config $use_java_script $edit_option_form
     $show_author $dirtable $tablepadding $columnHeaderColorDefault    $show_subdir_lastmod $show_log_in_markup $preformat_in_markup
     $columnHeaderColorSorted $hr_breakable $showfunc $hr_ignwhite    $tabstop $state $annTable $sel @ForbiddenFiles
     $hr_ignkeysubst $diffcolorHeading $diffcolorEmpty $diffcolorRemove    $use_descriptions %descriptions @mytz $dwhere
     $diffcolorChange $diffcolorAdd $diffcolorDarkChange $difffontface    $use_moddate $gzip_open $file_list_len
     $difffontsize $inputTextSize $mime_types    $allow_tar @tar_options @gzip_options @zip_options @cvs_options
     $allow_annotate $allow_markup    @annotate_options @rcsdiff_options
     $allow_log_extra $allow_dir_extra $allow_source_extra    $HTML_DOCTYPE $HTML_META $cssurl $CSS $cvshistory_url
     $use_java_script $open_extern_window    $allow_enscript @enscript_options %enscript_types
     $extern_window_width $extern_window_height $edit_option_form  
     $show_subdir_lastmod $show_log_in_markup $preformat_in_markup $v  
     $navigationHeaderColor $tableBorderColor $markupLogColor  
     $tabstop $state $annTable $sel $curbranch @HideModules @ForbiddenFiles  
     $module $use_descriptions %descriptions @mytz $dwhere $moddate  
     $use_moddate $has_zlib $gzip_open  
     $allow_tar @tar_options @gzip_options @zip_options @cvs_options  
     @annotate_options $LOG_FILESEPARATOR $LOG_REVSEPARATOR  
     $tmpdir $HTML_DOCTYPE $HTML_META  
 );  );
   
   use Cwd                   qw(abs_path);
   use File::Basename        qw(dirname);
   use File::Path            qw(rmtree);
   use File::Spec::Functions qw(canonpath catdir catfile curdir devnull rootdir
                                tmpdir updir);
   use File::Temp            qw(tempdir tempfile);
   use IPC::Run              qw();
   use Time::Local           qw(timegm);
   use URI::Escape           qw(uri_escape uri_unescape);
   
   use constant VALID_PATH   => qr/^([[:^cntrl:]]+)$/o;
   use constant VALID_TAG1   => qr/^([a-zA-Z][[:graph:]]*)$/o;
   use constant VALID_TAG2   => qr/^([^\$,.:;@]+)$/o;
   use constant CVSWEBMARKUP => qr{^text/(x-cvsweb|vnd\.viewcvs)-markup$}io;
   use constant LOG_FILESEPR => qr/^={77}$/o;
   use constant LOG_REVSEPR  => qr/^-{28}$/o;
   
   use constant HAS_ZLIB     => eval { require Compress::Zlib; };
   use constant HAS_EDIFF    => eval { require String::Ediff;  };
   
   # -----------------------------------------------------------------------------
   
   # All global initialization that can be done in compile time should go to
   # the BEGIN block.  Persistent environments, such as mod_perl, will benefit
   # from this.
   
   BEGIN
   {
     $VERSION = '3.0.6';
   
     $HTML_DOCTYPE =
       '<!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="FreeBSD-CVSweb $VERSION" />
   <meta http-equiv="Content-Script-Type" content="text/javascript" />
   <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 printDiffSelect($);
 sub printDiffLinks($$);  sub printDiffSelectStickyVars();
   sub getDiffLinks($$$);
 sub printLogSortSelect($);  sub printLogSortSelect($);
 sub findLastModifiedSubdirs(@);  sub findLastModifiedSubdirs(@);
 sub htmlify_sub(&$);  sub htmlify_sub(&$);
Line 107  sub spacedHtmlText($;$);
Line 155  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 getEnscriptHL($);
   sub getMimeType($;$);
 sub head($;$);  sub head($;$);
 sub scan_directives(@);  sub scan_directives(@);
 sub openOutputFilter();  sub openOutputFilter();
 sub doAnnotate($$);  sub doAnnotate($$);
 sub doCheckout($$);  sub doCheckout($$$);
 sub cvswebMarkup($$$);  sub doEnscript($$$;$);
   sub doGraph();
   sub doGraphView();
   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 134  sub chooseMirror();
Line 187  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 graph_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_file($);  sub forbidden($);
 sub forbidden_module($);  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 = '2.0.6';  my ($mydir) = (dirname($0) =~ /(.*)/);    # untaint
   
 use File::Basename ();  ##### Start of Configuration Area ########
   
 ($mydir) = (File::Basename::dirname($0) =~ /(.*)/);    # untaint  
   
 # == EDIT this ==  # == EDIT this ==
 # Locations to search for user configuration, in order:  # Locations to search for user configuration, in order:
 for ("$mydir/cvsweb.conf", '/usr/local/etc/cvsweb/cvsweb.conf') {  for (catfile($mydir, 'cvsweb.conf'), '/usr/local/etc/cvsweb/cvsweb.conf') {
         if (defined($_) && -r $_) {    if (-r $_) {
                 $config = $_;      $config = $_;
                 last;      last;
         }    }
 }  }
   
 # == Configuration defaults ==  
 # Defaults for configuration variables that shouldn't need  
 # to be configured..  
 $allow_version_select = 1;  
 $allow_log_extra = 1;  
   
 ##### End of Configuration Area   ########  ##### End of Configuration Area   ########
   
 ######## Configuration variables #########  undef $mydir;
 # These are defined to allow checking with perl -cw  
   ######## Configuration parameters #########
   
 @CVSrepositories = @CVSROOT = %CVSROOT = %MIRRORS = %DEFAULTVALUE = %ICONS =  @CVSrepositories = @CVSROOT = %CVSROOT = %MIRRORS = %DEFAULTVALUE = %ICONS =
     %MTYPES = %tags = %alltags = @tabcolors = %fileinfo = ();    %MTYPES = %tags = %alltags = %fileinfo = %DIFF_COMMANDS = ();
 $cvstreedefault = $body_tag = $body_tag_for_src = $logo = $defaulttitle =  
     $address = $long_intro = $short_instruction = $shortLogLen = $show_author =  
     $dirtable = $tablepadding = $columnHeaderColorDefault =  
     $columnHeaderColorSorted = $hr_breakable = $showfunc = $hr_ignwhite =  
     $hr_ignkeysubst = $diffcolorHeading = $diffcolorEmpty = $diffcolorRemove =  
     $diffcolorChange = $diffcolorAdd  = $diffcolorDarkChange = $difffontface   =  
     $difffontsize    = $inputTextSize = $mime_types          = $allow_annotate =  
     $allow_markup        = $use_java_script      = $open_extern_window =  
     $extern_window_width = $extern_window_height = $edit_option_form   =  
     $show_subdir_lastmod = $show_log_in_markup = $v = $navigationHeaderColor =  
     $tableBorderColor = $markupLogColor = $tabstop = $use_moddate = $moddate =  
     $gzip_open = $HTML_DOCTYPE = $HTML_META = undef;  
 $tmpdir = defined($ENV{TMPDIR}) ? $ENV{TMPDIR} : "/var/tmp";  
   
 $LOG_FILESEPARATOR = q/^={77}$/;  $cvstreedefault = $logo = $defaulttitle =
 $LOG_REVSEPARATOR  = q/^-{28}$/;    $address = $long_intro = $short_instruction = $shortLogLen = $show_author =
     $tablepadding = $hr_breakable = $showfunc = $hr_ignwhite =
     $hr_ignkeysubst = $inputTextSize = $mime_types = $allow_annotate =
     $allow_markup = $allow_compress = $use_java_script = $edit_option_form =
     $show_subdir_lastmod = $show_log_in_markup = $preformat_in_markup =
     $tabstop = $use_moddate = $gzip_open = $DEBUG = $allow_cvsgraph =
     $cvsgraph_config = $cvshistory_url = $allow_tar = undef;
   
   $allow_version_select = $allow_mailtos = $allow_log_extra = 1;
   
 @DIFFTYPES = qw(h H u c s);  @DIFFTYPES = 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',      'descr'   => 'side by side',
                 'opts'    => ['--side-by-side', '--width=164'],      # width=168 should be enough to support 80 character line lengths
                 'colored' => 0,      'opts'    => ['--side-by-side', '--width=168'],
         },      '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',  
         },  
 );  );
   
 $HTML_DOCTYPE =  ##### End of configuration parameters #####
   '<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">';  
   
 $HTML_META = <<EOM;  my $pathinfo = '';
 <meta name="robots" content="nofollow">  if (defined($ENV{PATH_INFO}) && $ENV{PATH_INFO} ne '') {
 <meta name="generator" content="FreeBSD-CVSweb $cvsweb_revision">    ($pathinfo) = ($ENV{PATH_INFO} =~ VALID_PATH)
 <meta http-equiv="Content-Script-Type" content="text/javascript">      or fatal('500 Internal Error',
 <meta http-equiv="Content-Style-Type" content="text/css">               'Illegal PATH_INFO in environment: <code>%s</code>',
 EOM               $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});
   }
   
 ##### End of configuration variables #####  $scriptname    = '' unless defined($scriptname);
   
 use Time::Local ();  $where         =  $pathinfo;
 use IPC::Open2 qw(open2);  $doCheckout    =  $where =~ s|^/$CheckoutMagic/|/|o;
   $where         =~ s|^/||;
   $scriptname    =~ s|^/*|/|;
   
 # Check if the zlib C library interface is installed, and if yes  
 # we can avoid using the extra gzip process.  
 eval { require Compress::Zlib; };  
 $has_zlib = !$@;  
   
 $verbose       = $v;  
 $checkoutMagic = "~checkout~";  
 $pathinfo      = defined($ENV{PATH_INFO}) ? $ENV{PATH_INFO} : '';  
 $where         = $pathinfo;  
 $doCheckout = ($where =~ m|^/$checkoutMagic/|);  
 $where =~ s|^/$checkoutMagic/|/|;  
 $where =~ s|^/||;  
 $scriptname = defined($ENV{SCRIPT_NAME}) ? $ENV{SCRIPT_NAME} : '';  
 $scriptname =~ s|^/*|/|;  
   
 # Let's workaround thttpd's stupidity..  # 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:  
 $Browser = $ENV{HTTP_USER_AGENT} || '';  
 $is_links    = ($Browser =~ m`^Links `);  
 $is_lynx     = ($Browser =~ m`^Lynx/`i);  $is_lynx     = ($Browser =~ m`^Lynx/`i);
 $is_w3m      = ($Browser =~ m`^w3m/`i);  $is_w3m      = ($Browser =~ m`^w3m/`i);
 $is_msie     = ($Browser =~ m`MSIE`);  $is_msie     = ($Browser =~ m`MSIE`);
Line 301  $nofilelinks = $is_textbased;
Line 338  $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 =  $maycompress = (
     (((defined($ENV{HTTP_ACCEPT_ENCODING})    ((defined($ENV{HTTP_ACCEPT_ENCODING})
     && $ENV{HTTP_ACCEPT_ENCODING} =~ m`gzip`) || $is_mozilla3) && !$is_msie      && $ENV{HTTP_ACCEPT_ENCODING} =~ /gzip/)
     && !($is_mod_perl && !$has_zlib));     || $is_mozilla3)
     && !$is_msie
     && !(defined($ENV{MOD_PERL}) && !HAS_ZLIB)
   );
   
 # 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);  
 @unsafevars = qw(logsort only_with_tag r1 r2 rev sortby tr1 tr2);  
   
   #
   # Load configuration.
   #
 if (-f $config) {  if (-f $config) {
         do "$config" or fatal("500 Internal Error",    do "$config" or config_error($config, $@);
                               'Error in loading configuration file: %s<br><br>%s<br>',  
                               $config, $@);  
 } else {  } else {
         fatal("500 Internal Error",    fatal("500 Internal Error",
               'Configuration not found.  Set the variable <code>$config</code> in cvsweb.cgi to your <b>cvsweb.conf</b> configuration file first.'          'Configuration not found.  Set the parameter <code>$config</code> 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);
       $val = 1 unless defined($val);
       ($key = uri_unescape($key)) =~ /[[:graph:]]/ or next;
       ($val = uri_unescape($val)) =~ /[[:graph:]]/ or next;
       $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(graph hideattic hidecvsroot hidenonreadable ignorecase ln copt
                 y/+/ /;                makeimage 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)$/)
                 } else {        or fatal('500 Internal Error',
                         $input{$_}++;                 'Invalid boolean value: <code>%s=%s</code>', $p, $t);
                 }    }
         }  
 }  }
   for my $p (qw(annotate r1 r2 rev tr1 tr2)) {
     $t = $query{$p};
     if (defined($t)) {
       if (($p eq 'r1' || $p eq 'r2') && $t eq 'text') {
         # Special case for the "Use text field" option in the log view diff form.
         $input{$p} = $t;
         next;
       } elsif (($p eq 'rev' || $p eq 'annotate') && ($t eq '.' || $t eq 'HEAD')){
         # Another special case, allow linking to latest revision using these.
         $input{$p} = '.';
         next;
       }
       my ($rev, $tag) = split(/:/, $t, 2);
       ($input{$p}) = ($rev =~ /^(\d+(?:\.\d+)*)$/)
         or fatal('500 Internal Error',
                  'Invalid revision: <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}));  
   
 # Prevent cross-site scripting  #
 foreach (@unsafevars) {  # CVS roots
         # Colons are needed in diffs between tags.  #
         if (defined($input{$_}) && $input{$_} =~ /[^\w\-.:]/) {  my $rootfound = 0;
                 fatal("500 Internal Error",  for (my $i = 0; $i < scalar(@CVSrepositories); $i += 2) {
                       'Malformed query (%s=%s)',    my $key = $CVSrepositories[$i];
                       $_, $input{$_});    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;
   
 if (defined($input{"content-type"})) {  #
         fatal("500 Internal Error", "Unsupported content-type")  # Default CVS root
             if ($input{"content-type"} !~ /^[-0-9A-Za-z]+\/[-0-9A-Za-z]+$/);  #
   if (!defined($CVSROOT{$cvstreedefault})) {
     fatal("500 Internal Error",
           '<code>$cvstreedefault</code> points to a repository (%s) not ' .
           'defined in <code>@CVSrepositories</code> in your configuration ' .
           'file (<code>%s</code>).',
           $cvstreedefault,
           $config);
 }  }
   
 $DEFAULTVALUE{'cvsroot'} = $cvstreedefault;  $DEFAULTVALUE{cvsroot} = $cvstreedefault;
   
 foreach (keys %DEFAULTVALUE) {  while (my ($key, $defval) = each %DEFAULTVALUE) {
   
         # replace not given parameters with the default parameters    # Replace not given parameters with defaults.
         if (!defined($input{$_}) || $input{$_} eq "") {    next unless (defined($defval) && $defval =~ /\S/ && !defined($input{$key}));
   
                 # Empty Checkboxes in forms return -- nothing. So we define a helper    # Empty checkboxes in forms return nothing, so we define a helper parameter
                 # variable in these forms (copt) which indicates that we just set    # in these forms (copt) which indicates that we just set parameters with a
                 # parameters with a checkbox    # checkbox.
                 if (!defined($input{"copt"})) {    if ($input{copt}) {
   
                         # 'copt' isn't defined --> empty input is not the result      # 'copt' is set -> the result of empty input checkbox
                         # of empty input checkbox --> set default      # -> set to zero (disable) if default is a boolean (0|1).
                         $input{$_} = $DEFAULTVALUE{$_}      $input{$key} = 0 if ($defval eq '0' || $defval eq '1');
                             if (defined($DEFAULTVALUE{$_}));  
                 } else {  
   
                         # 'copt' is defined -> the result of empty input checkbox    } else {
                         # -> set to zero (disable) if default is a boolean (0|1).  
                         $input{$_} = 0      # 'copt' isn't set --> empty input is not the result
                             if (defined($DEFAULTVALUE{$_})      # of empty input checkbox --> set default.
                             && ($DEFAULTVALUE{$_} eq "0"      $input{$key} = $defval;
                             || $DEFAULTVALUE{$_} eq "1"));    }
                 }  
         }  
 }  }
   
 $barequery = "";  $barequery = "";
 my @barequery;  my @barequery;
 foreach (@stickyvars) {  foreach (@stickyvars) {
   
         # construct a query string with the sticky non default parameters set    # construct a query string with the sticky non default parameters set
         if (defined($input{$_}) && $input{$_} ne ''    if (defined($input{$_})
             && !(defined($DEFAULTVALUE{$_}) && $input{$_} eq $DEFAULTVALUE{$_}))        && !(defined($DEFAULTVALUE{$_}) && $input{$_} eq $DEFAULTVALUE{$_}))
         {    {
                 push @barequery,      push(@barequery, join('=', uri_escape($_), uri_escape($input{$_})));
                     join ('=', urlencode($_), urlencode($input{$_}));    }
         }  
 }  }
   
   if ($allow_enscript) {
     push(@DIFFTYPES, qw(uc cc sc));
     @DIFFTYPES{qw(uc cc sc)} = (
       {
        'descr'   => 'unified, colored',
        'opts'    => ['-u'],
        'colored' => 0,
       },
       {
        'descr'   => 'context, colored',
        'opts'    => ['-c'],
        'colored' => 0,
       },
       {
        'descr'   => 'side by side, colored',
        # width=168 should be enough to support 80 character line lengths
        'opts'    => ['--side-by-side', '--width=168'],
        'colored' => 0,
       },
     );
   } else {
     # No Enscript -> respect difftype, but don't offer colorization.
     if ($input{f} && $input{f} =~ /^([ucs])c$/) {
       $input{f} = $1;
     }
   }
   
 # is there any query ?  # is there any query ?
 if (@barequery) {  if (@barequery) {
         $barequery = join ('&', @barequery);    $barequery = join (';', @barequery);
         $query     = "?$barequery";    $query     = "?$barequery";
         $barequery = "&$barequery";    $barequery = ";$barequery";
 } else {  } else {
         $query = "";    $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;  
 $byrev    = 0;  
 $byauthor = 0;  
 $bylog    = 0;  
 $byfile   = 0;  
 if ($sortby eq "date") {  
         $bydate = 1;  
 } elsif ($sortby eq "rev") {  
         $byrev = 1;  
 } elsif ($sortby eq "author") {  
         $byauthor = 1;  
 } elsif ($sortby eq "log") {  
         $bylog = 1;  
 } else {  
         $byfile = 1;  
 }  
   
 $defaultDiffType = $input{'f'};  
   
 $logsort = $input{'logsort'};  
   
 {  {
         my @tmp = @CVSrepositories;    my $sortby = $input{sortby} || 'file';
         my @pair;    $bydate    = 0;
     $byrev     = 0;
         while (@pair = splice(@tmp, 0, 2)) {    $byauthor  = 0;
                 my ($key,   $val)     = @pair;    $bylog     = 0;
                 my ($descr, $cvsroot) = @$val;    $byfile    = 0;
     if ($sortby eq 'date') {
                 next if !-d $cvsroot;      $bydate = 1;
     } elsif ($sortby eq 'rev') {
                 $CVSROOTdescr{$key} = $descr;      $byrev = 1;
                 $CVSROOT{$key}      = $cvsroot;    } elsif ($sortby eq 'author') {
                 push @CVSROOT, $key;      $byauthor = 1;
         }    } elsif ($sortby eq 'log') {
       $bylog = 1;
     } else {
       $byfile = 1;
     }
 }  }
   
 ## Default CVS-Tree  $defaultDiffType = $input{f};
 if (!defined($CVSROOT{$cvstreedefault})) {  
         fatal("500 Internal Error",  
               '<code>$cvstreedefault</code> points to a repository (%s) not defined in <code>%%CVSROOT</code> (edit your configuration file %s)',  
               $cvstreedefault, $config);  
 }  
   
   $logsort = $input{logsort};
   
 # 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
 foreach my $k (keys %ICONS) {  foreach my $k (keys %ICONS) {
         no strict 'refs';    my ($itxt, $ipath, $iwidth, $iheight) = @{$ICONS{$k}};
         my ($itxt, $ipath, $iwidth, $iheight) = @{$ICONS{$k}};    no strict 'refs';
         if ($ipath) {    if ($ipath) {
                 ${"${k}icon"} =      ${"${k}icon"} =
                     sprintf(        sprintf('<img src="%s" alt="%s" border="0" width="%d" height="%d" />',
                         '<img src="%s" alt="%s" border="0" width="%d" height="%d">',                htmlquote($ipath), htmlquote($itxt), $iwidth, $iheight);
                         hrefquote($ipath), htmlquote($itxt), $iwidth, $iheight)    } else {
         } else {      ${"${k}icon"} = $itxt;
                 ${"${k}icon"} = $itxt;    }
         }  
 }  }
   
 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) {
         do "$config_cvstree" or    do "$config_cvstree"
             fatal("500 Internal Error",      or fatal("500 Internal Error",
                   'Error in loading configuration file: %s<br><br>%s<br>',               'Error in loading configuration file: %s<br /><br />%s<br />',
                   $config_cvstree, $@);               $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",    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.');          '$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 %s forbidden.',  
               $where);  
 }  
   
 #  #
 # 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",    fatal('403 Forbidden', 'Downloading tarballs is prohibited.')
               '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",    $module       =~ s,/([^/]*)$,,;
                       'You cannot download the top level directory.');    my ($ext)     =  ($1 =~ /(\.t(?:ar\.)?gz|\.zip)$/);
         }    my ($basedir) =  ($module =~ m,([^/]+)$,);
   
         my $tmpexportdir = "$tmpdir/.cvsweb.$$." . int(time);    if ($basedir eq '' || $module eq '') {
       fatal('500 Internal Error',
             'You cannot download the top level directory.');
     }
   
         mkdir($tmpexportdir, 0700)    my $istar = ($ext eq '.tar.gz' || $ext eq '.tgz');
             or fatal("500 Internal Error",    if ($istar) {
                      'Unable to make temporary directory: %s',      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 =    my @fatal;
             (exists $input{only_with_tag} && length $input{only_with_tag}) ?    my $tag = $input{only_with_tag} || 'HEAD';
             $input{only_with_tag} : "HEAD";    $tag = 'HEAD' if ($tag eq 'MAIN');
   
         if ($tag eq 'MAIN') {    my @cmd =
             $tag = 'HEAD';      ($CMD{cvs}, @cvs_options, '-Qd', $cvsroot, 'export', '-r', $tag,
         }       '-d', $basedir, $module);
     my $export_err;
     my ($errcode, $err) = runproc(\@cmd, '2>', \$export_err);
     if ($errcode) {
       @fatal =
         ('500 Internal Error',
          'Export failure (exit status %s), output: <pre>%s</pre>',
          $errcode, $err || $export_err);
   
         if (system $CMD{cvs}, @cvs_options, '-Qd', $cvsroot, 'export', '-r',    } else {
             $tag, '-d', "$tmpexportdir/$basedir", $module)  
         {  
                 @fatal = ("500 Internal Error",  
                           'cvs co failure: %s: %s',  
                           $!, $module);  
         } else {  
                 $| = 1;    # Essential to get the buffering right.  
   
                 if ($ext eq '.tar.gz') {      $| = 1;    # Essential to get the buffering right.
                         print "Content-Type: application/x-gzip\r\n\r\n";      local (*TAR_OUT);
   
                         system      my (@cmd, $ctype);
                             "$CMD{tar} @tar_options -cf - -C $tmpexportdir $basedir | $CMD{gzip} @gzip_options -c"      if ($istar) {
                             and @fatal =        my @tar = ($CMD{tar}, @tar_options, '-cf', '-', $basedir);
                                 ("500 Internal Error",        my @gzip = ($CMD{gzip}, @gzip_options, '-c');
                                  'tar zc failure: %s: %s',        push(@cmd, \@tar, '|', \@gzip);
                              $!, $basedir);        $ctype = 'application/x-gzip';
                 } elsif ($ext eq '.zip' && $CMD{zip}) {      } elsif ($iszip) {
                         print "Content-Type: application/zip\r\n\r\n";        my @zip = ($CMD{zip}, @zip_options, '-r', '-', $basedir);
         push(@cmd, \@zip, \'');
         $ctype = 'application/zip';
       }
       push(@cmd, '>pipe', \*TAR_OUT);
   
                         system      my ($h, $err) = startproc(@cmd);
                             "cd $tmpexportdir && $CMD{zip} @zip_options -r - $basedir"      if ($h) {
                             and @fatal =        print "Content-Type: $ctype\r\n\r\n";
                                 ("500 Internal Error",        local $/ = undef;
                                  'zip failure: %s: %s',        print <TAR_OUT>;
                                  $!, $basedir);        $h->finish();
                 } else {      } else {
                         @fatal =        @fatal = ('500 Internal Error',
                             ("500 Internal Error",                  '%s failure (exit status %s), output: <pre>%s</pre>',
                              'unsupported file type');                  $istar ? 'Tar' : 'Zip', $? >> 8 || -1, $err);
                 }      }
         }    }
   
         system $CMD{rm}, '-rf', $tmpexportdir if -d $tmpexportdir;    # Clean up.
     rmtree($tmpexportdir);
   
         &fatal(@fatal) if @fatal;    &fatal(@fatal) if @fatal;
   
         exit;    exit;
 }  }
   
 ##############################  ##############################
 # View a directory  # View a directory
 ###############################  ###############################
 if (-d $fullname) {  if (-d $fullname) {
         my $dh = do { local (*DH); };  
         opendir($dh, $fullname) or fatal("404 Not Found",  
                                          '%s: %s',  
                                          $where, $!);  
         my @dir = readdir($dh);  
         closedir($dh);  
         my @subLevelFiles = findLastModifiedSubdirs(@dir)  
             if ($show_subdir_lastmod);  
         getDirLogs($cvsroot, $where, @subLevelFiles);  
   
         if ($where eq '/') {    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);
         } else {    my @subLevelFiles = findLastModifiedSubdirs(@dir) if $show_subdir_lastmod;
                 html_header($where);    my @unreadable = getDirLogs($cvsroot, $where, @subLevelFiles);
                 print $short_instruction;  
         }  
   
         if ($use_descriptions && open(DESC, "<$cvsroot/CVSROOT/descriptions"))    if ($where eq '/') {
         {      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') ||
                 close(DESC);                  -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></p>\n";    if ($use_descriptions &&
         open(DESC, catfile($cvsroot, 'CVSROOT', 'descriptions'))) {
       while (<DESC>) {
         chomp;
         my ($dir, $description) = /(\S+)\s+(.*)/;
         $descriptions{$dir} = $description;
       }
       close(DESC);
     }
   
         # give direct access to dirs    print "<p><a name=\"dirlist\"></a></p>\n";
         if ($where eq '/') {  
                 chooseMirror ();  
                 chooseCVSRoot ();  
         } else {  
                 print "<p>Current directory: <b>", &clickablePath($where, 0),  
                     "</b></p>\n";  
   
                 print "<p>Current tag: <b>", $input{only_with_tag},"</b></p>\n"    # give direct access to dirs
                     if $input{only_with_tag};    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    my $infocols = 1;
         # provides the results that I want in most browsers.  Another  
         # case of layout spooging up HTML.  
   
         my $infocols = 0;    printf(<<EOF, 'Directory index of ' . htmlquote($where));
         if ($dirtable) {  <table class="dir" width="100%%" cellspacing="0" cellpadding="$tablepadding" summary="%s">
                 print "<table style=\"border-width: 0";  <tr>
                 print "; background-color: $tableBorderColor"  EOF
                     if (defined $tableBorderColor);    printf('<th colspan="2"%s>', ($byfile ? ' class="sorted"' : ''));
                 print "\" width=\"100%\" cellspacing=\"1\" cellpadding=\"$tablepadding\">\n";  
                 $infocols++;  
                 printf "<tr>\n<th style=\"text-align: left; background-color: %s\">",  
                     $byfile ? $columnHeaderColorSorted :  
                     $columnHeaderColorDefault;  
   
                 if ($byfile) {    if ($byfile) {
                         print 'File';      print 'File';
                 } else {    } else {
                         print &link(      print &link('File',
                                 'File',                  sprintf('./%s#dirlist', toggleQuery('sortby', 'file')));
                                 sprintf(    }
                                         './%s#dirlist',    print "</th>\n";
                                         &toggleQuery("sortby", "file")  
                                 )  
                         );  
                 }  
                 print "</th>\n";  
   
                 # do not display the other column-headers, if we do not have any files    # Do not display the other column headers if we do not have any files
                 # with revision information:    # with revision information.
                 if (scalar(%fileinfo)) {    if (scalar(%fileinfo)) {
                         $infocols++;      $infocols++;
                         printf '<th style="text-align: left; background-color: %s">',      printf('<th%s>', ($byrev ? ' class="sorted"' : ''));
                             $byrev ? $columnHeaderColorSorted :  
                             $columnHeaderColorDefault;  
   
                         if ($byrev) {      if ($byrev) {
                                 print 'Rev.';        print 'Rev.';
                         } else {      } else {
                                 print &link(        print &link('Rev.',
                                         'Rev.',                    sprintf('./%s#dirlist', toggleQuery('sortby', 'rev')));
                                         sprintf(      }
                                                 './%s#dirlist',      print "</th>\n";
                                                 &toggleQuery("sortby", "rev")      $infocols++;
                                         )      printf('<th%s>', ($bydate ? ' class="sorted"' : ''));
                                 );  
                         }  
                         print "</th>\n";  
                         $infocols++;  
                         printf '<th style="text-align: left; background-color: %s">',  
                             $bydate ? $columnHeaderColorSorted :  
                             $columnHeaderColorDefault;  
   
                         if ($bydate) {      if ($bydate) {
                                 print 'Age';        print 'Age';
                         } else {      } else {
                                 print &link(        print &link('Age',
                                         'Age',                    sprintf('./%s#dirlist', toggleQuery('sortby', 'date')));
                                         sprintf(      }
                                                 './%s#dirlist',      print "</th>\n";
                                                 &toggleQuery("sortby", "date")  
                                         )  
                                 );  
                         }  
                         print "</th>\n";  
   
                         if ($show_author) {      if ($show_author) {
                                 $infocols++;        $infocols++;
                                 printf '<th style="text-align: left; background-color: %s">',        printf('<th%s>', ($byauthor ? ' class="sorted"' : ''));
                                     $byauthor ? $columnHeaderColorSorted :  
                                     $columnHeaderColorDefault;  
   
                                 if ($byauthor) {        if ($byauthor) {
                                         print 'Author';          print 'Author';
                                 } else {        } else {
                                         print &link(          print
                                                 'Author',            &link('Author',
                                                 sprintf(                  sprintf('./%s#dirlist', toggleQuery('sortby', 'author')));
                                                         './%s#dirlist',        }
                                                         &toggleQuery(        print "</th>\n";
                                                                 "sortby",      }
                                                                 "author"      $infocols++;
                                                         )      printf('<th%s>', ($bylog ? ' class="sorted"' : ''));
                                                 )  
                                         );  
                                 }  
                                 print "</th>\n";  
                         }  
                         $infocols++;  
                         printf '<th style="text-align: left; background-color: %s">',  
                             $bylog ? $columnHeaderColorSorted :  
                             $columnHeaderColorDefault;  
   
                         if ($bylog) {      if ($bylog) {
                                 print 'Last log entry';        print 'Last log entry';
                         } else {      } else {
                                 print &link(        print &link('Last log entry',
                                         'Last log entry',                    sprintf('./%s#dirlist', toggleQuery('sortby', 'log')));
                                         sprintf(      }
                                                 './%s#dirlist',      print "</th>\n";
                                                 &toggleQuery("sortby", "log")    } elsif ($use_descriptions) {
                                         )      print "<th>Description</th>\n";
                                 );      $infocols++;
                         }    }
                         print "</th>\n";    print "</tr>\n";
                 } elsif ($use_descriptions) {  
                         printf '<th style="text-align: left; background-color: s">',  
                             $columnHeaderColorDefault;  
                         print "Description</th>\n";  
                         $infocols++;  
                 }  
                 print "</tr>\n";  
         } else {  
                 print "<menu>\n";  
         }  
         my $dirrow = 0;  
   
         my $i;    my $dirrow = 0;
         lookingforattic:  
         for ($i = 0 ; $i <= $#dir ; $i++) {  
                 if ($dir[$i] eq "Attic") {  
                         last lookingforattic;  
                 }  
         }  
   
         if (!$input{'hideattic'} && ($i <= $#dir)    my $i;
             && opendir($dh, $fullname . "/Attic"))    lookingforattic:
         {    for ($i = 0; $i <= $#dir; $i++) {
                 splice(@dir, $i, 1, grep((s|^|Attic/|, !m|/\.|), readdir($dh)));      if ($dir[$i] eq "Attic") {
                 closedir($dh);        last lookingforattic;
         }      }
     }
   
         my $hideAtticToggleLink =    if (!$input{hideattic}
             $input{'hideattic'} ? '' :        && ($i <= $#dir)
             &link('[Hide]', sprintf('./%s#dirlist', &toggleQuery("hideattic")));        && opendir($dh, $fullname . '/Attic'))
     {
       splice(@dir, $i, 1, grep((s|^|Attic/|, !m|/\.|), readdir($dh)));
       closedir($dh);
     }
   
         # Sort without the Attic/ pathname.    my $hideAtticToggleLink =
         # place directories first      $input{hideattic}
       ? ''
       : &link('[hide]', sprintf('./%s#dirlist', &toggleQuery('hideattic')));
   
         my $attic;    # Sort without the Attic/ pathname.
         my $url;    # place directories first
         my $fileurl;  
         my $filesexists;  
         my $filesfound;  
   
         foreach my $file (sort { &fileSortCmp } @dir) {    my $filesexists;
     my $filesfound;
   
                 next if ($file eq '.');    foreach my $file (sort { &fileSortCmp } @dir) {
   
                 # ignore CVS lock and stale NFS files      next if ($file eq curdir());
                 next if ($file =~ /^#cvs\.|^,|^\.nfs/);  
   
                 # Check whether to show the CVSROOT path      # ignore CVS lock and stale NFS files
                 next if ($input{'hidecvsroot'} && $file eq 'CVSROOT');      next if ($file =~ /^\#cvs\.|^,|^\.nfs/); # \# for XEmacs cperl-mode...
   
                 # Check whether the module is in the restricted list      # Check whether to show the CVSROOT path
                 next if ($file && &forbidden_module($file));      next if ($input{hidecvsroot} && $where eq '/' && $file eq 'CVSROOT');
   
                 # Ignore non-readable files      # Is it a directory?
                 next if ($input{'hidenonreadable'} && !(-r "$fullname/$file"));      my $isdir = -d catdir($fullname, $file);
   
                 if ($file =~ s|^Attic/||) {      # Ignore non-readable files and directories?
                         $attic = " (in the Attic)&nbsp;" . $hideAtticToggleLink;      next if ($input{hidenonreadable} && (! -r _ || ($isdir && ! -x _)));
                 } else {  
                         $attic = "";  
                 }  
   
                 if ($file eq '..' || -d "$fullname/$file") {      my $attic = '';
                         next if ($file eq '..' && $where eq '/');      if ($file =~ s|^Attic/||) {
                         my ($rev, $date, $log, $author, $filename) =        $attic = ' <span class="attic">(in the Attic) ' .
                             @{$fileinfo{$file}}          $hideAtticToggleLink . '</span>';
                             if (defined($fileinfo{$file}));      }
                         printf "<tr style=\"background-color: %s\">\n<td>",  
                              $tabcolors[$dirrow % 2] if $dirtable;  
   
                         if ($file eq '..') {      if ($file eq updir() || $isdir) {
                                 $url = "../$query";        next if ($file eq updir() && $where eq '/');
                                 if ($nofilelinks) {        my ($rev, $date, $log, $author, $filename, $keywordsubst) =
                                         print $backicon;          @{$fileinfo{$file}} if (defined($fileinfo{$file}));
                                 } else {        printf "<tr class=\"%s\">\n<td class=\"dir\" colspan=\"2\">",
                                         print &link($backicon, $url);          ($dirrow % 2) ? 'even' : 'odd';
                                 }  
                                 print '&nbsp;', &link("Parent Directory", $url);  
                         } else {  
                                 $url = './' . urlencode($file) . "/$query";  
                                 print "<a name=\"$file\"></a>";  
   
                                 if ($nofilelinks) {        if ($file eq updir()) {
                                         print $diricon;          my $url = "../$query";
                                 } else {          print $nofilelinks ? $backicon : &link($backicon, $url);
                                         print &link($diricon, $url);          print '&nbsp;', &link("Parent Directory", $url);
                                 }  
                                 print '&nbsp;', &link("$file/", $url), $attic;  
   
                                 if ($file eq "Attic") {        } else {
                                         print "&nbsp; ";          my $url = './' . uri_escape_path($file) . "/$query";
                                         print &link(          print '<a name="', htmlquote($file), '"></a>';
                                                 "[Don't hide]",          print $nofilelinks ? $diricon : &link($diricon, $url);
                                                 sprintf(          print '&nbsp;', &link(htmlquote("$file/"), $url), $attic;
                                                         './%s#dirlist',          if ($file eq "Attic") {
                                                         &toggleQuery(            print ' <span class="attic">',
                                                                 "hideattic")              &link('[show]',
                                                 )                    sprintf('./%s#dirlist', &toggleQuery('hideattic'))),
                                         );                      '</span>';
                                 }          }
                         }        }
   
                         # Show last change in dir        # Show last change in dir
                         if ($filename) {        if ($filename) {
                                 print "</td>\n<td>&nbsp;</td>\n<td>&nbsp;"          print "</td>\n<td>&nbsp;</td>\n<td class=\"age\">";
                                     if ($dirtable);          print readableTime(time() - $date, 0) if $date;
                                 if ($date) {          print "</td>\n<td class=\"author\">", htmlquote($author)
                                         print " <i>",            if $show_author;
                                             readableTime(time() - $date, 0),          print "</td>\n<td class=\"log\">";
                                             "</i>";          $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);
           }
   
                                 if ($show_author) {        } else {
                                         print "</td>\n<td>&nbsp;" if ($dirtable);          my $dwhere = ($where ne '/' ? $where : '') . $file;
                                         print $author;  
                                 }  
                                 print "</td>\n<td>&nbsp;" if ($dirtable);  
                                 $filename =~ s%^[^/]+/%%;  
                                 print "$filename/$rev";  
                                 print "<br>" if ($dirtable);  
   
                                 if ($log) {          if ($use_descriptions && defined $descriptions{$dwhere}) {
                                         print "&nbsp;<span style=\"font-size: smaller\">",            print '<td colspan="', ($infocols - 1), '">';
                                           &htmlify(            print $descriptions{$dwhere};
                                                 substr($log, 0, $shortLogLen), $allow_dir_extra);  
                                         if (length $log > 80) {  
                                                 print "...";  
                                         }  
                                         print "</span>";  
                                 }  
                         } else {  
                                 my ($dwhere) =  
                                     ($where ne "/" ? $where : "") . $file;  
   
                                 if ($use_descriptions          } elsif ($infocols > 1) {
                                     && 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            # close the row with the appropriate number of
                                         # columns, so that the vertical seperators are visible            # columns, so that the vertical seperators are visible
                                         my ($cols) = $infocols;            my ($cols) = $infocols;
                                         while ($cols > 1) {            while ($cols > 1) {
                                                 print "</td>\n<td>&nbsp;";              print "</td>\n<td>&nbsp;";
                                                 $cols--;              $cols--;
                                         }            }
                                 }          }
                         }        }
   
                         if ($dirtable) {        print "</td>\n</tr>\n";
                                 print "</td>\n</tr>\n";        $dirrow++;
                         } else {  
                                 print "<br>\n";  
                         }  
                         $dirrow++;  
                 } elsif ($file =~ s/,v$//) {  
   
                         # Skip forbidden files now so we'll give no hint      } elsif ($file =~ s/,v$//) {
                         # about their existence.  This should probably have  
                         # been done earlier, but it's straightforward here.  
                         next if forbidden_file("$fullname/$file");  
   
                         $fileurl = ($attic ? "Attic/" : "") . urlencode($file);        my $fileurl = ($attic ? 'Attic/' : '') . uri_escape_path($file);
                         $url = './' . $fileurl . $query;        my $url     = './' . $fileurl . $query;
                         $filesexists++;        $filesexists++;
                         next if (!defined($fileinfo{$file}));        next if (!defined($fileinfo{$file}));
                         my ($rev, $date, $log, $author) = @{$fileinfo{$file}};        my ($rev, $date, $log, $author, $filename, $keywordsubst) =
                         $filesfound++;          @{$fileinfo{$file}};
                         printf "<tr style=\"background-color: %s\">\n<td>",        my $isbinary = $keywordsubst eq 'b' ? 1 : 0;
                             $tabcolors[$dirrow % 2] if $dirtable;        $filesfound++;
                         print "<a name=\"$file\"></a>";  
   
                         if ($nofilelinks) {        printf "<tr class=\"%s\">\n", ($dirrow % 2) ? 'even' : 'odd';
                                 print $fileicon;        printf '<td class="file"%s>', $allow_cvsgraph ? '' : ' colspan="2"';
                         } else {  
                                 print &link($fileicon, $url);  
                         }  
                         print '&nbsp;', &link(htmlquote($file), $url), $attic;  
                         print "</td>\n<td>&nbsp;" if ($dirtable);  
                         download_link($fileurl, $rev, $rev,  
                                 $defaultViewable ? "text/x-cvsweb-markup" :  
                                 undef);  
                         print "</td>\n<td>&nbsp;" if ($dirtable);  
   
                         if ($date) {        my $icon = $isbinary ? $binfileicon : $fileicon;
                                 print " <i>", readableTime(time() - $date, 0),        print $nofilelinks ? $icon : &link($icon, $url);
                                     "</i>";        print '&nbsp;', &link(htmlquote($file), $url), $attic;
                         }        print '</td><td class="graph">', graph_link($fileurl) if $allow_cvsgraph;
                         if ($show_author) {        print "</td>\n<td width=\"30\">", display_link($fileurl, $rev);
                                 print "</td>\n<td>&nbsp;" if ($dirtable);        print "</td>\n<td class=\"age\">";
                                 print $author;        print readableTime(time() - $date, 0) if $date;
                         }        print "</td>\n<td class=\"author\">", htmlquote($author) if $show_author;
                         print "</td>\n<td>&nbsp;" if ($dirtable);        print "</td>\n<td class=\"log\">";
   
                         if ($log) {        if ($log) {
                                 print " <span style=\"font-size: smaller\">",          print htmlify(substr($log, 0, $shortLogLen), $allow_dir_extra);
                                     &htmlify(substr($log, 0, $shortLogLen), $allow_dir_extra);          print '...' if (length $log > 80);
                                 if (length $log > 80) {        }
                                         print "...";        print "</td>\n</tr>";
                                 }        $dirrow++;
                                 print "</span>";      }
                         }      print "\n";
                         print "</td>\n" if ($dirtable);    }
                         print(($dirtable) ? "</tr>" : "<br>");  
                         $dirrow++;  
                 }  
                 print "\n";  
         }  
   
         print($dirtable ? "</table>\n" : "</menu>\n");    print "</table>\n";
   
         if ($filesexists && !$filesfound) {    if ((my $num = scalar(@unreadable)) && ! $input{hidenonreadable}) {
                 print      printf(<<EOF, $num, htmlquote(join(', ', @unreadable)));
                     "<p><b>NOTE:</b> There are $filesexists files, but none matches the current tag ($input{only_with_tag}).</p>\n";  <p>
         }   <b>NOTE:</b> The following %d unreadable files were ignored:<br />
         if ($input{only_with_tag} && (!%tags || !$tags{$input{only_with_tag}}))   <em>%s</em>
         {  </p>
                 %tags = %alltags  EOF
         }    }
   
         if (scalar %tags || $input{only_with_tag} || $edit_option_form    if ($filesexists && !$filesfound) {
             || defined($input{"options"}))      my $currtag = defined($input{only_with_tag}) ?
         {        sprintf(' (%s)', htmlquote($input{only_with_tag})) : '';
                 print "<hr size=\"1\" noshade>\n";      printf(<<EOF, $filesexists, $currtag);
         }  <p>
    <b>NOTE:</b> There are %d files, but none matches the current tag%s.
   </p>
   EOF
     }
   
         if (scalar %tags || $input{only_with_tag}) {    if ($input{only_with_tag} && (!%tags || !$tags{$input{only_with_tag}})) {
                 print "<form method=\"get\" action=\"./\">\n";      %tags = %alltags;
                 foreach my $var (@stickyvars) {    }
                         print  
                             "<input type=\"hidden\" name=\"$var\" value=\"$input{$var}\">\n"  
                             if (defined($input{$var})  
                             && (!defined($DEFAULTVALUE{$var})  
                             || $input{$var} ne $DEFAULTVALUE{$var})  
                             && $input{$var} ne "" && $var ne "only_with_tag");  
                 }  
                 print "<p><label for=\"only_with_tag\" accesskey=\"T\">";  
                 print "Show only files with tag:</label>\n";  
                 print "<select id=\"only_with_tag\" name=\"only_with_tag\"";  
                 print " onchange=\"this.form.submit()\"" if $use_java_script;  
                 print ">";  
                 print "<option value=\"\">All tags / default branch</option>\n";  
   
                 foreach my $tag (reverse sort { lc $a cmp lc $b } keys %tags) {    if (scalar %tags
                         print "<option",        || $input{only_with_tag}
                             defined($input{only_with_tag})        || $edit_option_form
                             && $input{only_with_tag} eq $tag ? " selected" : "",        || defined($input{options}))
                             ">$tag</option>\n";    {
                 }      print "<hr />\n";
                 print "</select>\n";    }
                 print " <label for=\"path\" accesskey=\"P\">";  
                 print "Module path or alias:</label>\n";  
                 printf "<input type=\"text\" id=\"path\" name=\"path\" value=\"%s\" size=\"15\">\n",  
                     htmlquote($where);  
                 print "<input type=\"submit\" value=\"Go\" accesskey=\"G\"></p>\n";  
                 print "</form>\n";  
         }  
   
         if ($allow_tar) {    if (scalar %tags || $input{only_with_tag}) {
                 my ($basefile) = ($where =~ m,(?:.*/)?([^/]+),);      print "<form method=\"get\" action=\"./\">\n<p>\n";
       foreach my $var (@stickyvars) {
         printf("<input type=\"hidden\" name=\"$var\" value=\"%s\" />\n",
                htmlquote($input{$var}))
           if (defined($input{$var})
               && (!defined($DEFAULTVALUE{$var})
                   || $input{$var} ne $DEFAULTVALUE{$var})
               && $var ne 'only_with_tag');
       }
       printf(<<EOF, ($use_java_script ? ' onchange="this.form.submit()"' : ''));
   <span class="nowrap">
   <label for="only_with_tag" accesskey="T">Show only files with tag:
   <select id="only_with_tag" name="only_with_tag"%s>
   <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 (defined($basefile) && $basefile ne '') {    if ($allow_tar && $filesfound) {
                         print "<hr noshade>\n",      my ($basefile) = ($where =~ m,(?:.*/)?([^/]+),);
                             "<div align=\"center\">Download this directory in ";      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";
       }
     }
   
                         # Mangle the filename so browsers show a reasonable    if ($edit_option_form || defined($input{options})) {
                         # 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>\n";  
                 }  
         }  
   
         if ($edit_option_form || defined($input{"options"})) {      print <<EOF;
   <form method="get" action="./">
                 my $formwhere = $scriptwhere;  <fieldset>
                 $formwhere =~ s|Attic/?$|| if ($input{'hideattic'});  <legend>General options</legend>
   <input type="hidden" name="copt" value="1" />
                 print "<form method=\"get\" action=\"${formwhere}\">\n";  EOF
                 print "<input type=\"hidden\" name=\"copt\" value=\"1\">\n";      for my $v qw(hidecvsroot hidenonreadable) {
                 if ($cvstree ne $cvstreedefault) {        printf(qq{<input type="hidden" name="%s" value="%s" />\n},
                         print               $v, $input{$v} || 0);
                             "<input type=\"hidden\" name=\"cvsroot\" value=\"$cvstree\">\n";      }
                 }      if ($cvstree ne $cvstreedefault) {
                 print "<center>\n<table cellpadding=\"0\" cellspacing=\"0\">";        print "<input type=\"hidden\" name=\"cvsroot\" value=\"$cvstree\" />\n";
                 print "\n<tr style=\"background-color: $columnHeaderColorDefault\">\n";      }
                 print "<th colspan=\"2\">Preferences</th>\n</tr>\n";      print <<EOF;
                 print "<tr>\n<td>";  <table summary="General options">
                 print "<label for=\"sortby\" accesskey=\"F\">Sort files by ";  <tr>
                 print "</label><select id=\"sortby\" name=\"sortby\">\n";  <td class="opt-label">
                 print "<option value=\"\">File</option>\n";  <label for="sortby" accesskey="F">Sort files by:</label>
                 print "<option", $bydate ? " selected" : "",  </td>
                     " value=\"date\">Age</option>\n";  <td class="opt-value">
                 print "<option", $byauthor ? " selected" : "",  <select id="sortby" name="sortby">
                     " value=\"author\">Author</option>\n"  <option value="">File</option>
                     if ($show_author);  EOF
                 print "<option", $byrev ? " selected" : "",      print "<option", $bydate ? ' selected="selected"' : '',
                     " value=\"rev\">Revision</option>\n";        " value=\"date\">Age</option>\n";
                 print "<option", $bylog ? " selected" : "",      print "<option", $byauthor ? ' selected="selected"' : '',
                     " value=\"log\">Log message</option>\n";        " value=\"author\">Author</option>\n"
                 print "</select>\n</td>\n";          if $show_author;
                 print "<td><label for=\"logsort\" accesskey=\"L\">";      print "<option", $byrev ? ' selected="selected"' : '',
                 print "Sort log by: </label>";        " value=\"rev\">Revision</option>\n";
                 printLogSortSelect(0);      print "<option", $bylog ? ' selected="selected"' : '',
                 print "</td>\n</tr>\n";        " value=\"log\">Log message</option>\n";
                 print "<tr>\n<td><label for=\"f\" accesskey=\"D\">";      print <<EOF;
                 print "Diff format: </label>";  </select>,
                 printDiffSelect(0);  <label for="ignorecase" accesskey="I">case-insensitive:
                 print "</td>\n";  EOF
                 print "<td><label for=\"hideattic\" accesskey=\"A\">";      print '<input id="ignorecase" name="ignorecase" type="checkbox"',
                 print "Show Attic files: </label>";        $input{ignorecase} ? ' checked="checked"' : '',
                 print "<input id=\"hideattic\" name=\"hideattic\" type=\"checkbox\"",          " value=\"1\" /></label>\n";
                     $input{'hideattic'} ? " checked" : "",      print <<EOF;
                      "></td>\n</tr>\n";  </td>
                 print "<tr>\n<td align=\"center\" colspan=\"2\">";  <td class="opt-label">
                 print "<input type=\"submit\" value=\"Change Options\" accesskey=\"C\">";  <label for="hideattic" accesskey="A">Hide files in Attic:</label>
                 print "</td>\n</tr>\n</table>\n</center>\n</form>\n";  </td>
         }  <td class="opt-value">
         html_footer();  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(0);
       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(0);
       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();
 }  }
   
 ###############################  ###############################
Line 1105  if (-d $fullname) {
Line 1282  if (-d $fullname) {
 ###############################  ###############################
 elsif (-f $fullname . ',v') {  elsif (-f $fullname . ',v') {
   
         if (forbidden_file($fullname)) {    if (defined($input{rev}) || $doCheckout) {
                 fatal('403 Forbidden',      &doCheckout($fullname, $input{rev}, $input{only_with_tag});
                       'Access forbidden.  This file is mentioned in @ForbiddenFiles');      gzipclose();
                 return;      exit;
         }    }
   
         if (defined($input{'rev'}) || $doCheckout) {    if (defined($input{annotate}) && $allow_annotate) {
                 &doCheckout($fullname, $input{'rev'});      &doAnnotate($input{annotate}, $input{only_with_tag});
                 gzipclose();      gzipclose();
                 exit;      exit;
         }    }
   
         if (defined($input{'annotate'}) && $allow_annotate) {    if (defined($input{r1}) && defined($input{r2})) {
                 &doAnnotate($input{'annotate'});      &doDiff($fullname,  $input{r1},  $input{tr1},
                 gzipclose();              $input{r2}, $input{tr2}, $input{f});
                 exit;      gzipclose();
         }      exit;
     }
   
         if (defined($input{'r1'}) && defined($input{'r2'})) {    if ($allow_cvsgraph && $input{graph}) {
                 &doDiff(      if ($input{makeimage}) {
                         $fullname,     $input{'r1'},        doGraph();
                         $input{'tr1'}, $input{'r2'},      } else {
                         $input{'tr2'}, $input{'f'}        doGraphView();
                 );      }
                 gzipclose();      gzipclose();
                 exit;      exit;
         }    }
         print("going to dolog($fullname)\n") if ($verbose);  
         &doLog($fullname);  
   
         ##############################    &doLog($fullname);
         # View Diff  }
         ##############################  
 } elsif ($fullname =~ s/\.diff$// && -f $fullname . ",v" && $input{'r1'}  ##############################
     && $input{'r2'})  # View Diff
   ##############################
   elsif ($fullname =~ s/\.diff$//
          && -f $fullname . ',v' && $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(    gzipclose();
                 $fullname,     $input{'r1'}, $input{'tr1'}, $input{'r2'},    exit;
                 $input{'tr2'}, $input{'f'}  
         );  
         gzipclose();  
         exit;  
 } elsif (($newname = $fullname) =~ s|/([^/]+)$|/Attic/$1| && -f $newname . ",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);  
   
         # Find the tags from each file  elsif (do { (my $tmp = $fullname) =~ s|/([^/]+)$|/Attic/$1|; -f "$tmp,v" }) {
         # Display a form offering diffs between said tags    # The file has been removed and is in the Attic.
 } else {    # Send a redirect pointing to the file in the Attic.
         my $fh = do { local (*FH); };    (my $newplace = $scriptwhere) =~ s|/([^/]+)$|/Attic/$1|;
         my ($xtra, $module);    if ($ENV{QUERY_STRING} ne "") {
       redirect("$newplace?$ENV{QUERY_STRING}");
     } else {
       redirect($newplace);
     }
     exit;
   
         # Assume it's a module name with a potential path following it.  }
         $xtra = (($module = $where) =~ s|/.*||) ? $& : '';  
   
         # Is there an indexed version of modules?  elsif (0 && (my @files = &safeglob($fullname . ",v"))) {
         if (open($fh, "< $cvsroot/CVSROOT/modules")) {    http_header("text/plain");
                 while (<$fh>) {    print "You matched the following files:\n";
                         if (/^(\S+)\s+(\S+)/o && $module eq $1    print join ("\n", @files);
                             && -d "$cvsroot/$2" && $module ne $2)  
                         {    # TODO:
                                 redirect("$scriptname/$2$xtra$query");    # Find the tags from each file
                         }    # Display a form offering diffs between said tags
                 }  
         }  
         fatal("404 Not Found",  
               '%s: no such file or directory',  
               $where);  
 }  }
   
   else {
     # Assume it's a module name with a potential path following it.
     my $module;
     my $xtra = (($module = $where) =~ s|(/.*)||) ? $1 : '';
   
     # Is there an indexed version of modules?
     my $fh = do { local (*FH); };
     if (open($fh, catfile($cvsroot, 'CVSROOT', 'modules'))) {
       while (<$fh>) {
         if (/^(\S+)\s+(\S+)/o
             && $module eq $1
             && $module ne $2
             && -d "$cvsroot/$2")
         {
           close($fh);
           redirect("$scriptname/$2$xtra$query");
         }
       }
       close($fh);
     }
     fatal("404 Not Found", '%s: no such file or directory', $where);
   }
   
 gzipclose();  gzipclose();
   
 ## End MAIN  ## End MAIN
   
 sub printDiffSelect($) {  
         my ($use_java_script) = @_;  
         my $f = $input{'f'};  
   
         print '<select id="f" name="f"';  sub printDiffSelect($)
         print ' onchange="this.form.submit()"' if $use_java_script;  {
         print ">\n";    my ($use_java_script) = @_;
   
         local $_;    print '<select id="f" name="f"';
         for (@DIFFTYPES) {    print ' onchange="this.form.submit()"' if $use_java_script;
                 printf("<option value=\"%s\"%s>%s</option>\n", $_,    print ">\n";
                     $f eq $_ ? ' selected' : '', "\u$DIFFTYPES{$_}{'descr'}");  
         }  
   
         print "</select>";    for my $difftype (@DIFFTYPES) {
       printf("<option value=\"%s\"%s>%s</option>\n",
              $difftype, $input{f} eq $difftype ? ' selected="selected"' : '',
              "\u$DIFFTYPES{$difftype}{descr}");
     }
   
     print "</select>";
 }  }
   
 sub printLogSortSelect($) {  
         my ($use_java_script) = @_;  
   
         print '<select id="logsort" name="logsort"';  sub printDiffSelectStickyVars()
         print ' onchange="this.form.submit()"' if $use_java_script;  {
         print ">\n";    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</option>\n", $_,  
                     $logsort eq $_ ? ' selected' : '',  
                     "\u$LOGSORTKEYS{$_}{'descr'}");  
         }  
   
         print "</select>";  sub printLogSortSelect($)
 }  {
     my ($use_java_script) = @_;
   
 sub findLastModifiedSubdirs(@) {    print '<select id="logsort" name="logsort"';
         my (@dirs) = @_;    print ' onchange="this.form.submit()"' if $use_java_script;
         my ($dirname, @files);    print ">\n";
   
         foreach $dirname (@dirs) {    for my $sortkey (@LOGSORTKEYS) {
                 next if ($dirname eq ".");      printf("<option value=\"%s\"%s>%s</option>\n",
                 next if ($dirname eq "..");             $sortkey, $logsort eq $sortkey ? ' selected="selected"' : '',
                 my ($dir) = "$fullname/$dirname";             "\u$LOGSORTKEYS{$sortkey}{descr}");
                 next if (!-d $dir);    }
   
                 my ($lastmod)     = undef;    print "</select>";
                 my ($lastmodtime) = undef;  }
                 my $dh = do { local (*DH); };  
   
                 opendir($dh, $dir) or next;  
                 my (@filenames) = readdir($dh);  
                 closedir($dh);  
   
                 foreach my $filename (@filenames) {  #
                         $filename = "$dirname/$filename";  # Find the last modified, version controlled files in the given directories.
                         my ($file) = "$fullname/$filename";  # Compares solely based on modification timestamps.  Files in the returned list
                         next if ($filename !~ /,v$/ || !-f $file);  # are without the ,v suffix, and unreadable files have been filtered out.
   #
   sub findLastModifiedSubdirs(@)
   {
     my (@dirs) = @_;
   
                         # Skip forbidden files.    my @files;
                         (my $f = $file) =~ s/,v$//;    foreach my $dirname (@dirs) {
                         next if forbidden_file($f);      next if ($dirname eq curdir() || $dirname eq updir());
       my $dir = catdir($fullname, $dirname);
       next if (!-d $dir);
   
                         $filename =~ s/,v$//;      my $dh = do { local (*DH); };
                         my $modtime = -M $file;      opendir($dh, $dir) or next;
       my (@filenames) = grep(!forbidden(catfile($dir, $_)), readdir($dh));
       closedir($dh);
   
                         if (!defined($lastmod) || $modtime < $lastmodtime) {      my $lastmod     = undef;
                                 $lastmod     = $filename;      my $lastmodtime = undef;
                                 $lastmodtime = $modtime;      foreach my $filename (@filenames) {
                         }        ($filename) =
                 }          (catfile($dirname, $filename) =~ VALID_PATH) or next; # untaint
                 push (@files, $lastmod) if (defined($lastmod));        my ($file) = catfile($fullname, $filename);
         }        next if ($filename !~ /,v$/o || !-f $file || !-r _);
         return @files;        my $modtime = -M _;
         if (!defined($lastmod) || $modtime < $lastmodtime) {
           ($lastmod    = $filename) =~ s/,v$//;
           $lastmodtime = $modtime;
         }
       }
       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
         $_ = htmlify_sub {    s{
                 s<      ((https?|ftp)://.+?)([\s\']|&(quot|[lg]t);)
           [\w+=\-.!]+@[\w\-]+(\.[\w\-]+)+     }{
             ><       &link($1, htmlunquote($1)) . $3
               &link($&, "mailto:$&")     }egx;
                 >egix;  
             }  
             $_;  
   
         if ($extra) {    if ($allow_mailtos) {
       # Make mailto: links from email addresses.
       $_ = htmlify_sub {
         s<
           ([\w+=\-.!]+@[\w\-]+(?:\.[\w\-]+)+)
          ><
            &link($1, "mailto:$1")
          >egix;
       } $_;
     }
   
                 # get PR #'s as link: "PR#nnnn" "PR: nnnn, ..." "PR nnnn, ..." "bin/nnnn"    if ($extra) {
                 if (defined($prcgi) && 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*  
                        (?:  
                         \#?  
                         \d+[,\s]\s*  
                        )*  
                        \#?)  
                       (\d+)\b  
                      }{  
                          $1 . &link($2, sprintf($prcgi, $2))  
                      }egix;  
                                     }  
                                     $_;  
                         } while ($_ ne $prev);  
   
                         if (defined($re_prcategories)) {          $_ = htmlify_sub {
                                 $_ = htmlify_sub {            s{
                                         s{              (\b$re_prkeyword[:\#]?\s*
                           (\b$re_prcategories/(\d+)\b)               (?:
                         }{                \#?
                                 &link($1, sprintf($prcgi, $2))                \d+[,\s]\s*
                         }egox;               )*
                                     }               \#?)
                                     $_;              (\d+)\b
                         }             }{
                 }               $1 . &link($2, sprintf($prcgi, $2))
              }egix;
           } $_;
         } while ($_ ne $prev);
   
                 # get manpage specs as link: "foo.1" "foo(1)"        if (defined($re_prcategories)) {
                 if (defined($mancgi)) {          $_ = htmlify_sub {
                         $_ = htmlify_sub {            s{
                                 s{              (\b$re_prcategories/(\d+)\b)
                   (\b([a-zA-Z][\w.]+)             }{
                    (?:               &link($1, sprintf($prcgi, $2))
                     \( ([0-9n]) \)\B             }egox;
                     |          } $_;
                     \.([0-9n])\b        }
                    )      }
                   )  
                  }{  
                      &link($1, sprintf($mancgi, defined($3) ? $3 : $4, $2))  
                  }egx;  
                             }  
                             $_;  
                 }  
         }  
   
         $_;      # get manpage specs as link: "foo.1" "foo(1)"
       if (defined($mancgi)) {
         $_ = htmlify_sub {
           s{
             (
              \b ( \w[\w+\-.]* (?: ::\w[\w+\-.]*)* )
              (?:
               \( ([0-9n]) \) \B
               |
               \. ([0-9n]) \b
              )
             )
            }{
               my($text, $name, $section) = ($1, $2, defined($3) ? $3 : $4);
               ($name =~ /[A-Za-z]/ && $name !~ /\.(:|$)/)
                ? &link($text, sprintf($mancgi, $section, uri_escape($name)))
                 : $text;
            }egx;
         } $_;
       }
     }
   
     return $_;
 }  }
   
 sub spacedHtmlText($;$) {  
         local $_ = $_[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
     1 while s/(.*?)(\t+)/$1 . ' ' x (length($2) * $ts - length($1) % $ts)/e;
   
                 # Expand tabs    if ($hr_breakable) {
                 1 while s/\t+/' ' x (length($&) * $ts - length($`) % $ts)/e      s/^ /\001nbsp;/;      # protect leading and...
         }      s/ $/\001nbsp;/;      # ...trailing whitespace (mostly for String::Ediff),
       s/  / \001nbsp;/g;    # ...and leave every other space 'breakable'
     } else {
       s/ /\001nbsp;/g;
     }
   
         # replace <tab> and <space> (\001 is to protect us from htmlify)    $_ = htmlify($_, $allow_source_extra);
         # gzip can make excellent use of this repeating pattern :-)  
         if ($hr_breakable) {  
   
                 # make every other space 'breakable'    # unescape
                 s/  / \001nbsp;/g;    # 2 * <space>    y/\001/&/;
                                       # leave single space as it is  
         } else {  
                 s/ /\001nbsp;/g;  
         }  
   
         $_ = htmlify($_, $allow_source_extra);    return $_;
   }
   
         # unescape  
         y/\001/&/;  
   
         return $_;  # Note that this doesn't htmlquote the first argument...
   sub link($$)
   {
     my ($name, $url) = @_;
     return sprintf('<a href="%s">%s</a>', htmlquote($url), $name);
 }  }
   
 # Note that this doesn't htmlquote the first argument...  
 sub link($$) {  
         my ($name, $url) = @_;  
   
         $url =~ s/:/sprintf("%%%02x", ord($&))/eg  sub revcmp($$)
             if $url =~ /^[^a-z]/;    # relative  {
     my ($rev1, $rev2) = @_;
   
         sprintf '<a href="%s">%s</a>', hrefquote($url), $name;    # make no comparison for a tag or a branch
 }    return 0 if $rev1 =~ /[^\d.]/ || $rev2 =~ /[^\d.]/;
   
 sub revcmp($$) {    my (@r1) = split(/\./, $rev1);
         my ($rev1, $rev2) = @_;    my (@r2) = split(/\./, $rev2);
     my ($a, $b);
   
         # make no comparison for a tag or a branch    while (($a = shift(@r1)) && ($b = shift(@r2))) {
         return 0 if $rev1 =~ /[^\d.]/ || $rev2 =~ /[^\d.]/;      return $a <=> $b unless ($a == $b);
     }
     if (@r1) { return  1; }
     if (@r2) { return -1; }
     return 0;
   }
   
         my (@r1) = split (/\./, $rev1);  
         my (@r2) = split (/\./, $rev2);  
         my ($a, $b);  
   
         while (($a = shift (@r1)) && ($b = shift (@r2))) {  #
                 if ($a != $b) {  # Signal a fatal error.
                         return $a <=> $b;  #
                 }  sub fatal($$@)
         }  {
         if (@r1) { return 1; }    my ($errcode, $format, @args) = @_;
         if (@r2) { return -1; }    print "Status: $errcode\r\n";
         return 0;    html_header('Error');
     print '<div id="error">Error: ',
       sprintf($format, map(htmlquote($_), @args)), "</div>\n";
     html_footer();
     exit(1);
 }  }
   
 sub fatal($$@) {  
         my ($errcode, $format, @args) = @_;  #
         if ($is_mod_perl) {  # Signal a (fatal) configuration error.
                 Apache->request->status((split (/ /, $errcode))[0]);  #
         } else {  sub config_error($$)
                 print "Status: $errcode\r\n";  {
         }    fatal('500 Internal Error',
         html_header("Error");          'Error loading configuration file "<code>%s</code>":<br /><br />' .
         print "<p>Error: ",          '%s<br />', @_);
           sprintf($format, map(htmlquote($_), @args)),  
           "</p>\n";  
         html_footer();  
         exit(1);  
 }  }
   
 sub redirect($) {  
         my ($url) = @_;  #
         if ($is_mod_perl) {  # Sends a redirect to the given URL.
                 Apache->request->status(301);  #
                 Apache->request->header_out(Location => $url);  sub redirect($;$)
         } else {  {
                 print "Status: 301 Moved\r\n";    my ($url, $permanent) = @_;
                 print "Location: $url\r\n";    my ($status, $text);
         }    if ($permanent) {
         html_header("Moved");      $status = '301';
         print "<p>This document is located ", &link('here', $url), "</p>\n";      $text   = 'Moved Permanently';
         html_footer();    } else {
         exit(1);      $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 safeglob($) {  
         my ($filename) = @_;  
         my ($dirname);  
         my (@results);  
         my $dh = do { local (*DH); };  
   
         ($dirname = $filename) =~ s|/[^/]+$||;  sub safeglob($)
         $filename =~ s|.*/||;  {
     my ($filename) = @_;
   
         if (opendir($dh, $dirname)) {    (my $dirname = $filename) =~ s|/[^/]+$||;
                 my $glob = $filename;    $filename =~ s|.*/||;
                 my $t;  
   
                 #       transform filename from glob to regex.  Deal with:    my @results;
                 #       [, {, ?, * as glob chars    my $dh = do { local (*DH); };
                 #       make sure to escape all other regex chars    if (opendir($dh, $dirname)) {
                 $glob =~ s/([\.\(\)\|\+])/\\$1/g;      my $glob = $filename;
                 $glob =~ s/\*/.*/g;      my $t;
                 $glob =~ s/\?/./g;  
                 $glob =~ s/{([^}]+)}/($t = $1) =~ s-,-|-g; "($t)"/eg;  
                 foreach (readdir($dh)) {  
   
                         if (/^${glob}$/) {      #   transform filename from glob to regex.  Deal with:
                                 push (@results, "$dirname/" . $_);      #   [, {, ?, * as glob chars
                         }      #   make sure to escape all other regex chars
                 }      $glob =~ s/([\.\(\)\|\+])/\\$1/g;
                 closedir($dh);      $glob =~ s/\*/.*/g;
         }      $glob =~ s/\?/./g;
       $glob =~ s/{([^}]+)}/($t = $1) =~ s-,-|-g; "($t)"/eg;
       $glob = qr/^$glob$/;
   
         @results;      foreach (readdir($dh)) {
         if ($_ =~ $glob && $_ =~ VALID_PATH) {
           push(@results, catfile($dirname, $1)); # untaint
         }
       }
       closedir($dh);
     }
   
     return @results;
 }  }
   
 sub search_path($) {  
         my ($command) = @_;  
         my $d;  
   
         for $d (split (/:/, $command_path)) {  #
                 return "$d/$command" if -x "$d/$command";  # Searches @command_path for the given executable file.
         }  #
   sub search_path($)
   {
     my ($command) = @_;
     for my $d (@command_path) {
       my $cmd = catfile($d, $command);
       return $cmd if (-x $cmd && !-d _);
     }
     return '';
   }
   
         '';  
   #
   # Gets the enscript(1) highlight mode corresponding to the given filename,
   # or undef if unsupported.
   #
   sub getEnscriptHL($)
   {
     return undef unless $allow_enscript;
     my ($filename) = @_;
     while (my ($hl, $regex) = each %enscript_types) {
       return $hl if ($filename =~ $regex);
     }
     return undef;
 }  }
   
 sub getMimeTypeFromSuffix($) {  
         my ($fullname) = @_;  
         my ($mimetype, $suffix);  
         my $fh = do { local (*FH); };  
   
         ($suffix = $fullname) =~ s/^.*\.([^.]*)$/$1/;  #
         $mimetype = $MTYPES{$suffix};  # Gets the MIME type for the given file name.
         $mimetype = $MTYPES{'*'} if (!$mimetype);  #
   sub getMimeType($;$)
   {
     my ($fullname, $binary) = @_;
     $binary = ($keywordsubstitution && $keywordsubstitution =~ /b/)
       unless defined($binary);
   
         if (!$mimetype && -f $mime_types) {    (my $suffix = $fullname) =~ s/^.*\.([^.]*)$/$1/;
   
                 # okey, this is something special - search the    my $mimetype = $MTYPES{$suffix};
                 # mime.types database    $mimetype  ||= $MimeTypes->mimeTypeOf($fullname) if defined($MimeTypes);
                 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 && $suffix ne '*' && -f $mime_types && -r _) {
         if (!($mimetype =~ /\S\/\S/)) {      my $fh = do { local (*FH); };
                 $mimetype = "text/plain";      if (open($fh, $mime_types)) {
         }        my $re = sprintf('^\s*(\S+\/\S+)\s.+\b%s\b', quotemeta($suffix));
         return $mimetype;        $re = qr/$re/;
         while (my $line = <$fh>) {
           if ($line =~ $re) {
             $mimetype = $1;
             $MTYPES{$suffix} = $mimetype;
             last;
           }
         }
         close($fh);
       } else {
         warn("Can't open MIME types file $mime_types for reading: $!");
       }
     }
   
     $mimetype ||= $MTYPES{'*'};
     $mimetype ||= $binary ? 'application/octet-stream' : 'text/plain';
     return $mimetype;
 }  }
   
   
 ###############################  ###############################
 # read first lines like head(1)  # 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 = <$fh>;    return @buf;
         }  
   
         @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 if !defined($output_filter) || $output_filter eq '';  
   
         open(STDOUT, "|-") and return;  sub openOutputFilter()
   {
     return unless $output_filter;
   
         # child of child    open(STDOUT, "|-") and return;
         open(STDERR, '>/dev/null');  
         exec($output_filter) or exit -1;    # 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 "%s"',    # the cvs server in a similiar way one day (..after rewrite).
                       $ENV{QUERY_STRING});  
         }  
   
         ($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;    #     Root /home/kingdon/zwork/cvsroot
         $| = 0;    # Flush    #     Argument foo/xx
     #     Directory foo
     #     /home/kingdon/zwork/cvsroot/foo
     #     Directory .
     #     /home/kingdon/zwork/cvsroot
     #     annotate
     # although as you can see there are a few more details.
   
         # Work around a mod_perl bug (?) in order to make open2() work.    print CVS_IN "Root $cvsroot\n";
         # Search for "untie STDIN" in mod_perl mailing list archives.    print CVS_IN
         my $old_stdin;      "Valid-responses ok error Valid-requests Checked-in Updated Merged Removed M E\n";
         if ($is_mod_perl && ($old_stdin = tied *STDIN)) {  
           local $^W = undef;  
           untie *STDIN;  
         }  
   
         # this annotate version is based on the    # Don't worry about sending valid-requests, the server just needs to
         # cvs annotate-demo Perl script by Cyclic Software    # support "annotate" and if it doesn't, there isn't anything to be done.
         # It was written by Cyclic Software, http://www.cyclic.com/, and is in    print CVS_IN "UseUnchanged\n";
         # the public domain.    print CVS_IN "Argument -r\n";
         # we could abandon the use of rlog, rcsdiff and co using    print CVS_IN "Argument $rev\n";
         # the cvsserver in a similiar way one day (..after rewrite)    print CVS_IN "Argument $where\n";
         $pid = open2($reader, $writer, $CMD{cvs}, @annotate_options, 'server')  
             or fatal("500 Internal Error",  
                      'Fatal Error - unable to open cvs for annotation');  
   
         # Re-tie STDIN if we fiddled around with it earlier, just to be sure.    # The protocol requires us to fully fake a working directory (at
         tie(*STDIN, ref($old_stdin), $old_stdin) if ($old_stdin && !tied(*STDIN));    # least to the point of including the directories down to the one
     # containing the file in question).
     # So if $where is "dir/sdir/file", then dirs will be ("dir","sdir","file")
     my $path = '';
     foreach my $dir (split('/', $where)) {
   
         # OK, first send the request to the server.  A simplified example is:      if ($path eq "") {
         #     Root /home/kingdon/zwork/cvsroot        # In our example, $dir is "dir".
         #     Argument foo/xx        $path = $dir;
         #     Directory foo      } else {
         #     /home/kingdon/zwork/cvsroot/foo        print CVS_IN "Directory $path\n";
         #     Directory .        print CVS_IN "$cvsroot/$path\n";
         #     /home/kingdon/zwork/cvsroot  
         #     annotate  
         # although as you can see there are a few more details.  
   
         print $writer "Root $cvsroot\n";        # In our example, $_ is "sdir" and $path becomes "dir/sdir"
         print $writer        # And the next time, "file" and "dir/sdir/file" (which then gets
             "Valid-responses ok error Valid-requests Checked-in Updated Merged Removed M E\n";        # ignored, because we don't need to send Directory for the file).
         $path .= "/$dir";
       }
     }
     undef $path;
   
         # Don't worry about sending valid-requests, the server just needs to    # And the last "Directory" before "annotate" is the top level.
         # support "annotate" and if it doesn't, there isn't anything to be done.    print CVS_IN "Directory .\n";
         print $writer "UseUnchanged\n";    print CVS_IN "$cvsroot\n";
         print $writer "Argument -r\n";  
         print $writer "Argument $rev\n";  
         print $writer "Argument $where\n";  
   
         # The protocol requires us to fully fake a working directory (at    print CVS_IN "annotate\n";
         # least to the point of including the directories down to the one  
         # containing the file in question).  
         # So if $where is "dir/sdir/file", then @dirs will be ("dir","sdir","file")  
         my @dirs = split ('/', $where);  
         my $path = "";  
         foreach (@dirs) {  
   
                 if ($path eq "") {    # OK, we've sent our command to the server.  Thing to do is to
     # close the writer side and get all the responses.
     if (!close(CVS_IN)) {
       $h->finish();
       fatal('500 Internal Error',
             'Annotate failure (exit status %s): <code>%s</code>, output: ' .
             '<pre>%s</pre>', $? >> 8, $!, $annotate_err);
     }
   
                         # In our example, $_ is "dir".    navigateHeader($scriptwhere, $pathname, $filename, $rev, 'annotate');
                         $path = $_;  
                 } else {  
                         print $writer "Directory $path\n";  
                         print $writer "$cvsroot/$path\n";  
   
                         # In our example, $_ is "sdir" and $path becomes "dir/sdir"    my $revtype = ($rev =~ /\./) ? 'revision' : 'tag'; # TODO: tag -> branch/tag?
                         # And the next time, "file" and "dir/sdir/file" (which then gets    print '<h3 style="text-align: center">Annotation of ',
                         # ignored, because we don't need to send Directory for the file).      htmlquote("$pathname$filename"), ", $revtype $rev</h3>\n";
                         $path .= "/$_";  
                 }  
         }  
   
         # And the last "Directory" before "annotate" is the top level.    # Ready to get the responses from the server.
         print $writer "Directory .\n";    # For example:
         print $writer "$cvsroot\n";    #     E Annotations for foo/xx
     #     E ***************
     #     M 1.3          (kingdon  06-Sep-97): hello
     #     ok
     my ($lineNr) = 0;
     my ($oldLrev, $oldLusr) = ("", "");
     my ($revprint, $usrprint);
   
         print $writer "annotate\n";    if ($annTable) {
       print <<EOF;
   <table style="border: none" cellspacing="0" cellpadding="0" summary="Annotation">
   EOF
     } else {
       print "<pre>";
     }
   
         # OK, we've sent our command to the server.  Thing to do is to    # prefetch several lines
         # close the writer side and get all the responses.  If "cvs server"    my @buf = head(*CVS_OUT);
         # were nicer about buffering, then we could just leave it open, I think.  
         close($writer) or die "cannot close: $!";  
   
         http_header();    my %d = scan_directives(@buf);
   
         navigateHeader($scriptwhere, $pathname, $filename, $rev, "annotate");    while (@buf || !eof(*CVS_OUT)) {
         print  
             "<h3 style=\"text-align: center\">Annotation of $pathname$filename, Revision $rev</h3>\n";  
   
         # Ready to get the responses from the server.      $_ = @buf ? shift @buf : <CVS_OUT>;
         # For example:      my @words = split;
         #     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) {      # Adding one is for the (single) space which follows $words[0].
                 print "<table style=\"border: none\" cellspacing=\"0\" cellpadding=\"0\">\n";      my $rest = substr($_, length($words[0]) + 1);
         } else {      if ($words[0] eq "E") {
                 print "<pre>";        next;
         }      } elsif ($words[0] eq "M") {
         $lineNr++;
         (my $lrev = substr($_, 2,  13)) =~ y/ //d;
         (my $lusr = substr($_, 16, 9))  =~ y/ //d;
         my $line = substr($_, 36);
         # TODO: this does not work for branch/tag revisions.
         my $isCurrentRev = ($rev eq $lrev);
   
         # prefetch several lines        # we should parse the date here ..
         my @buf = head($reader);        if ($lrev eq $oldLrev) {
           $revprint = sprintf('%-8s', '');
         } else {
           $revprint = sprintf('%-8s', $lrev);
           $revprint =~ s|(\S+)|&link($1, uri_escape($filename)."$query#rev$1")|e;
           $oldLusr = '';
         }
   
         my %d = scan_directives(@buf);        $usrprint = ($lusr eq $oldLusr) ? '' : $lusr;
         $oldLrev = $lrev;
         $oldLusr = $lusr;
   
         while (@buf || !eof($reader)) {        print $is_textbased ? '<b>' : '<span class="current-rev">'
                 $_ = @buf ? shift @buf : <$reader>;          if $isCurrentRev;
   
                 my @words = split;        $usrprint = sprintf('%-8s', $usrprint);
         printf '%s%s %s %4d:', $revprint, $isCurrentRev ? '!' : ' ',
           htmlquote($usrprint), $lineNr;
         print spacedHtmlText($line, $d{tabstop});
   
                 # Adding one is for the (single) space which follows $words[0].        print $is_textbased ? '</b>' : '</span>' if $isCurrentRev;
                 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 ..      } elsif ($words[0] eq "ok") {
                         if ($lrev eq $oldLrev) {        # We could complain about any text received after this, like the
                                 $revprint = sprintf('%-8s', '');        # CVS command line client.  But for simplicity, we don't.
                         } else {  
                                 $revprint = sprintf('%-8s', $lrev);  
                                 $revprint =~  
                                     s`\S+`&link($&, "$scriptwhere$query#rev$&")`e  
                                     ;    # `  
                                 $oldLusr = '';  
                         }  
   
                         if ($lusr eq $oldLusr) {      } elsif ($words[0] eq "error") {
                                 $usrprint = '';        fatal("500 Internal Error",
                         } else {              'Error occured during annotate: <b>%s</b>', $_);
                                 $usrprint = $lusr;      }
                         }    }
                         $oldLrev = $lrev;    $h->finish();
                         $oldLusr = $lusr;  
   
                         # Set bold for text-based browsers only - graphical    if ($annTable) {
                         # browsers show bold fonts a bit wider than regular fonts,      print "</table>";
                         # so it looks irregular.    } else {
                         print "<b>" if ($isCurrentRev && $is_textbased);      print "</pre>";
     }
     html_footer();
   }
   
                         printf "%s%s %-8s %4d:", $revprint,  ###############################
                             $isCurrentRev ? '!' : ' ', $usrprint, $lineNr;  # make Checkout
                         print spacedHtmlText($line, $d{'tabstop'});  ###############################
   sub doCheckout($$$)
   {
     my ($fullname, $rev, $tag) = @_;
     $rev = $tag || undef if (!$rev || $rev eq '.');
   
                         print "</b>" if ($isCurrentRev && $is_textbased);    # Start resolving whether we will do a markup view or not.
                 } elsif ($words[0] eq "ok") {    my $do_markup = undef;
     my $want_type = $input{'content-type'};
   
                         # We could complain about any text received after this, like the    # No markup if markup disallowed.
                         # CVS command line client.  But for simplicity, we don't.    $do_markup = 0 unless $allow_markup;
                 } elsif ($words[0] eq "error") {  
                         fatal("500 Internal Error",  
                               'Error occured during annotate: <b>%s</b>',  
                               $_);  
                 }  
         }  
   
         if ($annTable) {    # No markup if checkout magic cookie in URL.
                 print "</table>";    $do_markup = 0 if (!defined($do_markup) && $doCheckout);
         } else {  
                 print "</pre>";  
         }  
         html_footer();  
   
         close($reader) or warn "cannot close: $!";    # Do markup if explicitly asked using cvsweb-markup content type.  If the
         wait;    # 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;
       }
     }
   
 ###############################    # Ok, if $do_markup is still undefined, we know that a download has not been
 # make Checkout    # explicitly asked.  For the last check further down below we'll need to
 ###############################    # know if the file is binary, and possibly run a log on it.
 sub doCheckout($$) {    my $needlog = $do_markup || $use_moddate;
         my ($fullname, $rev) = @_;  
         my ($mimetype, $revopt);  
         my $fh = do { local (*FH); };  
   
         if ($rev eq 'HEAD' || $rev eq '.') {    my $moddate = undef;
                 $rev = undef;    my $revopt;
         }    if (defined($rev)) {
       $revopt = "-r$rev";
       if ($needlog) {
         readLog($fullname, $rev);
         $moddate   = $date{$rev};
         # TODO: even this does not work for branch tags, but only normal tags :(
         $moddate ||= $date{$symrev{$rev}} if defined($symrev{$rev});
       }
     } else {
       $revopt = "-rHEAD";
       if ($needlog) {
         readLog($fullname);
         $moddate = $date{$symrev{HEAD}};
       }
     }
   
         # make sure the revisions a wellformed, for security    my $cr = abs_path($cvsroot) || $cvsroot;
         # reasons ..    # abs_path() taints when run as a CGI...
         if (defined($rev) && $rev =~ /[^\w.]/) {    if ($cr =~ VALID_PATH) {
                 fatal("404 Not Found",      $cr = $1;
                       'Malformed query "%s"',    } else {
                       $ENV{QUERY_STRING});      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);
   
         # get mimetype    local (*CVS_OUT, *CVS_ERR);
         if (defined($input{"content-type"})    my ($h, $err) =
             && ($input{"content-type"} =~ /\S\/\S/))      startproc(\@cmd, \"", '>pipe', \*CVS_OUT, '2>pipe', \*CVS_ERR);
         {    fatal('500 Internal Error',
                 $mimetype = $input{"content-type"}          'Checkout failure (exit status %s), output: <pre>%s</pre>',
         } else {          $? >> 8 || -1, $err)
                 $mimetype = &getMimeTypeFromSuffix($fullname);      unless $h;
         }  
   
         if (defined($rev)) {    if (eof(CVS_ERR)) {
                 $revopt = "-r$rev";      $h->finish();
                 if ($use_moddate) {      fatal("404 Not Found", '%s is not (any longer) pertinent', $where);
                         readLog($fullname, $rev);    }
                         $moddate = $date{$rev};  
                 }  
         } else {  
                 $revopt = "-rHEAD";  
   
                 if ($use_moddate) {    #===================================================================
                         readLog($fullname);    #Checking out squid/src/ftp.c
                         $moddate = $date{$symrev{HEAD}};    #RCS:  /usr/src/CVS/squid/src/ftp.c,v
                 }    #VERS: 1.1.1.28.6.2
         }    #***************
   
         ### just for the record:    # Parse CVS header
         ### 'cvs co' seems to have a bug regarding single checkout of    my ($revision, $filename, $cvsheader);
         ### directories/files having spaces in it;    $filename = "";
         ### this is an issue that should be resolved on cvs's side    while (<CVS_ERR>) {
         #      last if (/^\*\*\*\*/);
         # Safely for a child process to read from.      $revision = $1 if (/^VERS: (.*)$/);
         if (!open($fh, "-|")) {    # child  
                  # chdir to $tmpdir before to avoid non-readable cgi-bin directories  
                 chdir($tmpdir);  
                 open(STDERR, ">&STDOUT");    # Redirect stderr to stdout  
   
                 # work around a bug of cvs -p; expand symlinks      if (/^Checking out (.*)$/) {
                 use Cwd 'abs_path';        ($filename = $1) =~ s|^\./+||;
                 exec($CMD{cvs}, @cvs_options,      }
                      '-d', abs_path($cvsroot),      $cvsheader .= $_;
                      'co', '-p',    }
                      $revopt, $where) or exit -1;    close(CVS_ERR);
         }  
   
         if (eof($fh)) {    if ($filename ne $where) {
                 fatal("404 Not Found",      $h->finish();
                       '%s is not (any longer) pertinent',      fatal("500 Internal Error",
                       $where);            '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.
         #Checking out squid/src/ftp.c    my $isbin = $keywordsubstitution && $keywordsubstitution =~ /b/;
         #RCS:  /usr/src/CVS/squid/src/ftp.c,v    my $mimetype = getMimeType($fullname, $isbin);
         #VERS: 1.1.1.28.6.2  
         #***************  
   
         # Parse CVS header    # If we still are not sure whether to do markup or not:
         my ($revision, $filename, $cvsheader);    # if the MIME type is "viewable" or this is not a binary file, do.
         $filename = "";    $do_markup = !$isbin || viewable($mimetype) unless defined($do_markup);
         while (<$fh>) {  
                 last if (/^\*\*\*\*/);  
                 $revision = $1 if (/^VERS: (.*)$/);  
   
                 if (/^Checking out (.*)$/) {    if ($do_markup) {
                         $filename = $1;  
                         $filename =~ s/^\.\/*//;  
                 }  
                 $cvsheader .= $_;  
         }  
   
         if ($filename ne $where) {      # If this is something we'll be linking to in the markup view, we are
                 fatal("500 Internal Error",      # done with this particular output from "cvs co" and must discard it.
                       'Unexpected output from cvs co: %s',      my $linked = $mimetype =~ m{^image/|application/pdf$}i;
                       $cvsheader);      if ($linked) {
         }        close(CVS_OUT);
         $| = 1;        $h->finish();
       }
   
         if ($mimetype eq "text/x-cvsweb-markup") {      # Here we know the last modified date, but don't know if tags have been
                 &cvswebMarkup($fh, $fullname, $revision);      # added afterwards (those are shown in the markup view): no last-modified.
         } else {      cvswebMarkup(\*CVS_OUT, $fullname, $revision, $isbin, $mimetype, $needlog);
                 http_header($mimetype);  
                 print <$fh>;      $h->finish() unless $linked;
         }  
         close($fh);    } else {
       http_header($want_type || $mimetype, $moddate);
       local $/ = undef;
       print <CVS_OUT>;
       $h->finish();
     }
 }  }
   
 sub cvswebMarkup($$$) {  
         my ($filehandle, $fullname, $revision) = @_;  
         my ($pathname,   $filename);  
   
         ($pathname = $where) =~ s/(Attic\/)?[^\/]*$//;  sub cvswebMarkup($$$$$$;$)
         ($filename = $where) =~ s/^.*\///;  {
         my ($fileurl) = urlencode($filename);    my ($filehandle, $fullname, $rev, $isbin, $mimetype, $logged, $mod) = @_;
   
         http_header();    (my $pathname = $where) =~ s|((?<=/)Attic/)?[^/]*$||;
     (my $filename = $where) =~ s|^.*/||;
   
         navigateHeader($scriptwhere, $pathname, $filename, $revision, "view");    navigateHeader($scriptwhere, $pathname, $filename, $rev, 'view', $mod);
         print "<hr noshade>";  
         print "<table width=\"100%\">\n<tr>\n<td style=\"background-color: $markupLogColor\">";  
         print "File: ", &clickablePath($where, 1);  
         print "&nbsp;(";  
         &download_link($fileurl, $revision, "download");  
         print ")";  
   
         if (!$defaultTextPlain) {    print <<EOF;
                 print "&nbsp;(";  <hr />
                 &download_link($fileurl, $revision, "as text", "text/plain");  <div class="log-markup">
                 print ")";  File:&nbsp;
         }  EOF
         print "<br>\n";    print &clickablePath($where, 1), "<br />\n";
   
         if ($show_log_in_markup) {    if ($show_log_in_markup) {
                 readLog($fullname);    #,$revision);      readLog($fullname) unless $logged; #,$rev);
                 printLog($revision, 0);      printLog($rev, $mimetype, $isbin);
         } else {    } else {
                 print "Version: <b>$revision</b><br>\n";      print "Revision: <b>$rev</b><br />\n";
                 print "Tag: <b>", $input{only_with_tag}, "</b><br>\n"      print 'Tag: ', htmlquote($input{only_with_tag}), "<br />\n"
                     if $input{only_with_tag};        if $input{only_with_tag};
         }    }
         print "</td>\n</tr>\n</table>";    print "</div>\n<hr />";
         my $url = download_url($fileurl, $revision, $mimetype);    my $url = download_url(uri_escape($filename), $rev, $mimetype);
         print "<hr noshade>";  
   
         if ($mimetype =~ /^image/) {    if ($mimetype =~ m|^image/|i) {
                 printf '<img src="%s" alt=""><br>', hrefquote("$url$barequery");      printf '<img src="%s" alt="%s" /><br />',
         } elsif ($mimetype =~ m%^application/pdf%) {        $url . $barequery, htmlquote($filename);
                 printf '<embed src="%s" width="100%"><br>',    } elsif (lc($mimetype) eq 'application/pdf') {
                     hrefquote("$url$barequery");      printf '<embed src="%s" width="100%%" height="100%%" /><br />',
         } elsif ($preformat_in_markup) {        $url . $barequery;
                 print "<pre>";    } else {
   
                 # prefetch several lines      print "<pre>\n";
                 my @buf = head($filehandle);      my $linenumbers = $input{ln} || 0;
   
                 my %d = scan_directives(@buf);      if (my $enscript_hl = getEnscriptHL($filename)) {
         doEnscript($filehandle, $enscript_hl, $linenumbers);
   
                 while (@buf || !eof($filehandle)) {      } else {
                         $_ = @buf ? shift @buf : <$filehandle>;        my $ln  = 0;
         my @buf = ();
         my $ts  = undef;
   
                         print spacedHtmlText($_, $d{'tabstop'});        if ($preformat_in_markup) {
                 }          # prefetch several lines
                 print "</pre>";          @buf = head($filehandle);
         } else {          my %d = scan_directives(@buf);
                 print "<pre>";          $ts = $d{tabstop};
         }
   
                 while (<$filehandle>) {        while (@buf || !eof($filehandle)) {
                         print htmlquote($_);          $_ = @buf ? shift @buf : <$filehandle>;
                 }          if ($linenumbers) {
                 print "</pre>";            $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($) {  
         my ($mimetype) = @_;  
   
         $mimetype =~ m%^((text|image)/|application/pdf)%;  sub viewable($)
   {
     return shift =~ m{^((text|image)/|application/pdf)}i;
 }  }
   
   
 ###############################  ###############################
 # Show Colored Diff  # Show Colored Diff
 ###############################  ###############################
 sub doDiff($$$$$$) {  sub doDiff($$$$$$)
         my ($fullname, $r1, $tr1, $r2, $tr2, $f) = @_;  {
         my $fh = do { local (*FH); };    my ($fullname, $r1, $tr1, $r2, $tr2, $f) = @_;
         my ($rev1, $rev2, $sym1, $sym2, $f1, $f2);  
   
         if (&forbidden_file($fullname)) {    if (forbidden($fullname)) {
                 fatal("403 Forbidden",      fatal('403 Forbidden', 'Access to %s forbidden.', $where);
                       'Access forbidden.  This file is mentioned in @ForbiddenFiles');    }
                 return;  
         }  
   
         if ($r1 =~ /([^:]+)(:(.+))?/) {    my ($rev1, $sym1);
                 $rev1 = $1;    if ($r1 =~ /([^:]+)(:(.+))?/) {
                 $sym1 = $3;      $rev1 = $1;
         }      $sym1 = $3;
         if ($r1 eq 'text') {    }
                 $rev1 = $tr1;    if ($r1 eq 'text') {
                 $sym1 = "";      $rev1 = $tr1;
         }      $sym1 = "";
     }
   
         if ($r2 =~ /([^:]+)(:(.+))?/) {    my ($rev2, $sym2);
                 $rev2 = $1;    if ($r2 =~ /([^:]+)(:(.+))?/) {
                 $sym2 = $3;      $rev2 = $1;
         }      $sym2 = $3;
         if ($r2 eq 'text') {    }
                 $rev2 = $tr2;    if ($r2 eq 'text') {
                 $sym2 = "";      $rev2 = $tr2;
         }      $sym2 = "";
     }
   
         # make sure the revisions a wellformed, for security    #
         # reasons ..    # rev1 and rev2 are now both numeric revisions.
         if ($rev1 =~ /[^\w.]/ || $rev2 =~ /[^\w.]/) {    # Thus we do a DWIM here and swap them if rev1 is after rev2.
                 fatal("404 Not Found",    # XXX should we warn about the fact that we do this?
                       'Malformed query "%s"',    if (&revcmp($rev1, $rev2) > 0) {
                       $ENV{QUERY_STRING});      my ($tmp1, $tmp2) = ($rev1, $sym1);
         }      ($rev1, $sym1) = ($rev2, $sym2);
       ($rev2, $sym2) = ($tmp1, $tmp2);
     }
   
         #    my $mimetype = getMimeType($fullname);
         # rev1 and rev2 are now both numeric revisions.  
         # Thus we do a DWIM here and swap them if rev1 is after rev2.  
         # XXX should we warn about the fact that we do this?  
         if (&revcmp($rev1, $rev2) > 0) {  
                 my ($tmp1, $tmp2) = ($rev1, $sym1);  
                 ($rev1, $sym1) = ($rev2, $sym2);  
                 ($rev2, $sym2) = ($tmp1, $tmp2);  
         }  
         my $difftype = $DIFFTYPES{$f};  
   
         if (!$difftype) {    #
                 fatal("400 Bad arguments",    #  Check for per-MIME type diff commands.
                       'Diff format %s not understood',    #
                       $f);    my $diffcmd = undef;
         }    if (my $diffcmds = $DIFF_COMMANDS{lc($mimetype)}) {
       if ($f =~ /^ext(\d*)$/) {
         my $n = $1 || 0;
         $diffcmd = $diffcmds->[$n];
       }
     }
     if ($diffcmd && $diffcmd->{cmd} && $diffcmd->{name}) {
   
         my @difftype       = @{$difftype->{'opts'}};      if ($diffcmd->{args} && ref($diffcmd->{args}) ne 'ARRAY') {
         my $human_readable = $difftype->{'colored'};        fatal('500 Internal Error',
               'Configuration error: arguments to external diff tools must ' .
               'be given as array refs.  See "<code>%s</code>" in ' .
               '<code>%%DIFF_COMMANDS</code>.',
               $diffcmd->{name});
       }
   
         # apply special options      (my $cvsname = $where) =~ s/\.diff$//;
         if ($showfunc) {  
                 push @difftype, '-p' if $f ne 's';  
   
                 my ($re1, $re2);      # Create two temporary files with the two revisions
       my $temp_fn1 = checkout_to_temp($cvsroot, $cvsname, $rev1);
       my $temp_fn2 = checkout_to_temp($cvsroot, $cvsname, $rev2);
   
                 while (($re1, $re2) = each %funcline_regexp) {      # Execute chosen diff binary.
                         if ($fullname =~ /$re1/) {      local (*DIFF_OUT);
                                 push @difftype, '-F', $re2;      my @cmd = ($diffcmd->{cmd});
                                 last;      push(@cmd, @{$diffcmd->{args}}) if $diffcmd->{args};
                         }      push(@cmd, $temp_fn1, $temp_fn2);
                 }      my ($h, $err) = startproc(\@cmd, \"", '>pipe', \*DIFF_OUT);
         }      if (!$h) {
         unlink($temp_fn1);
         unlink($temp_fn2);
         fatal('500 Internal Error',
               'Diff failure (exit status %s), output: <pre>%s</pre>',
               $? >> 8 || -1, $err);
       }
   
         if ($human_readable) {      http_header($diffcmd->{type} || 'text/plain');
                 if ($hr_ignwhite) {      local $/ = undef;
                         push @difftype, '-w';      print <DIFF_OUT>;
                 }      $h->finish();
                 if ($hr_ignkeysubst) {      unlink($temp_fn1);
                         push @difftype, '-kk';      unlink($temp_fn2);
                 }  
         }  
   
         if (!open($fh, "-|")) {    # child      exit;
                 open(STDERR, ">&STDOUT");    # Redirect stderr to stdout    }
                 openOutputFilter();  
                 exec($CMD{rcsdiff}, @difftype, "-r$rev1", "-r$rev2", $fullname) or exit -1;  
         }  
         if ($human_readable) {  
                 http_header();  
                 &human_readable_diff($fh, $rev2);  
                 html_footer();  
                 gzipclose();  
                 exit;  
         } else {  
                 http_header("text/plain");  
         }  
   
         #    #
         #===================================================================    # Normal CVS diff.
         #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>) {    $f = $DEFAULTVALUE{f} || 'u' if ($f =~ /^ext\d*$/);
                 if (m|^$f1 $cvsroot|o) {    my $difftype = $DIFFTYPES{$f};
                         s|$cvsroot/||o;    if (!$difftype) {
                         if ($sym1) {      fatal("400 Bad arguments", 'Diff format %s not understood', $f);
                                 chop;    }
                                 $_ .= " $sym1\n";  
                         }  
                 } elsif (m|^$f2 $cvsroot|o) {  
                         s|$cvsroot/||o;  
   
                         if ($sym2) {    my @difftype       = @{$difftype->{opts}};
                                 chop;    my $human_readable = $difftype->{colored};
                                 $_ .= " $sym2\n";  
                         }    # Apply special diff options.  -p and -F are not available with side by side
                 }    # diffs and may cause problems with older (< 2.8) versions of diffutils if
                 print $_;    # used with --side-by-side.
         }    if ($showfunc && $f !~ /^s/) {
         close($fh);      push(@difftype, '-p');
       while (my ($re1, $re2) = each %funcline_regexp) {
         if ($fullname =~ $re1) {
           push(@difftype, '-F', $re2);
           last;
         }
       }
     }
   
     if ($human_readable) {
       push(@difftype, '-w')  if $hr_ignwhite;
       push(@difftype, '-kk') if $hr_ignkeysubst;
     }
   
     my $fh = do { local (*FH); };
     if (!open($fh, "-|")) {    # child
       open(STDERR, ">&STDOUT");    # Redirect stderr to stdout
       openOutputFilter();
       exec($CMD{rcsdiff}, @rcsdiff_options, @difftype, "-r$rev1", "-r$rev2",
            $fullname) or exit -1;
     }
   
     if ($human_readable) {
       #
       # Human readable diff.
       #
       human_readable_diff($fh, $rev2);
       html_footer();
       gzipclose();
       exit;
   
     } elsif ($f =~ /^([ucs])c$/) {
       #
       # Enscript colored diff.
       #
       my $hl = 'diff';
       $hl .= $1 if ($1 eq 'u' || $1 eq 's');
       (my $where_nd = $where)       =~ s/\.diff$//;
       (my $pathname = $where_nd)    =~ s|((?<=/)Attic/)?[^/]*$||;
       (my $filename = $where_nd)    =~ s|^.*/||;
       (my $swhere   = $scriptwhere) =~ s|\.diff$||;
       navigateHeader($swhere, $pathname, $filename, $rev2, 'diff');
       printf(<<EOF, $where_nd, $rev1, $rev2);
   <h3 style="text-align: center">Diff for /%s between versions %s and %s</h3>
   <pre>
   EOF
       doEnscript(\$fh, $hl, 0, 'cvsweb_diff');
       print <<EOF;
   </pre>
   <hr style="width: 100%" />
   <form method="get" action="$scriptwhere">
   EOF
       printDiffSelectStickyVars();
       print 'Diff format: ';
       printDiffSelect($use_java_script);
       print "<input type=\"submit\" value=\"Show\" />\n</form>\n";
       html_footer();
       gzipclose();
       exit;
   
     } else {
       #
       # Plain diff.
       #
       http_header("text/plain");
     }
   
     #
     #===================================================================
     #RCS file: /home/ncvs/src/sys/netinet/tcp_output.c,v
     #retrieving revision 1.16
     #retrieving revision 1.17
     #diff -c -r1.16 -r1.17
     #*** /home/ncvs/src/sys/netinet/tcp_output.c     1995/11/03 22:08:08     1.16
     #--- /home/ncvs/src/sys/netinet/tcp_output.c     1995/12/05 17:46:35     1.17
     #
     # Ideas:
     # - nuke the stderr output if it's what we expect it to be
     # - Add "no differences found" if the diff command supplied no output.
     #
     #*** src/sys/netinet/tcp_output.c     1995/11/03 22:08:08     1.16
     #--- src/sys/netinet/tcp_output.c     1995/12/05 17:46:35     1.17 RELENG_2_1_0
     # (bogus example, but...)
     #
     my ($f1, $f2);
     if (grep { $_ eq '-u' } @difftype) {
       $f1 = '---';
       $f2 = '\+\+\+';
     } else {
       $f1 = '\*\*\*';
       $f2 = '---';
     }
   
     while (<$fh>) {
       if (m|^$f1 $cvsroot|o) {
         s|$cvsroot/||o;
         if ($sym1) {
           chop;
           $_ .= " $sym1\n";
         }
       } elsif (m|^$f2 $cvsroot|o) {
         s|$cvsroot/||o;
   
         if ($sym2) {
           chop;
           $_ .= " $sym2\n";
         }
       }
       print $_;
     }
     close($fh);
 }  }
   
   
 ###############################  ###############################
 # Show Logs ..  # Show Logs ..
 ###############################  ###############################
 sub getDirLogs($$@) {  sub getDirLogs($$@)
         my ($cvsroot, $dirname, @otherFiles) = @_;  {
         my ($state, $otherFiles, $tag, $file, $date, $branchpoint, $branch,    my ($cvsroot, $dirname, @otherFiles) = @_;
             $log);    my $tag = $input{only_with_tag};
         my ($rev, $revision, $revwanted, $filename, $head, $author);    my $DirName = catdir($cvsroot, $where);
   
         $tag = $input{only_with_tag};    my @files = &safeglob("$DirName/*,v");
     push (@files, &safeglob("$DirName/Attic/*,v")) unless $input{hideattic};
     foreach my $file (@otherFiles) {
       push(@files, catfile($DirName, $file));
     }
   
         my ($DirName) = "$cvsroot/$where";    # Weed out unreadable files.
         my (@files, @filetags);    my $i = 0;
         my $fh = do { local (*FH); };    my @unreadable = ();
     while ($i < scalar(@files)) {
       # Note: last modified files from subdirs returned by
       # findLastModifiedSubdirs() come without the ,v suffix so they're not
       # found here, but have already been checked for readability.  *cough*
       if (-r $files[$i] || !-e _) {
         $i++;
       } else {
         push(@unreadable, splice(@files, $i, 1));
       }
     }
   
         push (@files, &safeglob("$DirName/*,v"));    # If there are no files, we're done.
         push (@files, &safeglob("$DirName/Attic/*,v"))    return @unreadable unless @files;
             if (!$input{'hideattic'});  
         foreach my $file (@otherFiles) {  
                 push (@files, "$DirName/$file");  
         }  
   
         # just execute rlog if there are any files    my @cmd = ($CMD{rlog});
         if ($#files < 0) {    # Can't use -r<tag> as '-' is allowed in tagnames,
                 return;    # but misinterpreted by rlog.
         }    push(@cmd, '-r') unless defined($tag);
   
         if (defined($tag)) {    my $fh = do { local (*FH); };
     if (!open($fh, '-|')) {                       # Child
       open(STDERR, '>', devnull()) unless $DEBUG; # Ignore rlog's complaints.
       openOutputFilter();
       if ($file_list_len && $file_list_len > 1) {
         while (scalar(@files) > $file_list_len) {  # Process files in chunks.
           system(@cmd, splice(@files, 0, $file_list_len)) == 0 or exit -1;
         }
       }
       exec(@cmd, @files) or exit -1;
     }
     undef @cmd;
   
                 #can't use -r<tag> as - is allowed in tagnames, but misinterpreated by rlog..    my $state = 'start';
                 if (!open($fh, "-|")) {    # child    my ($date, $branchpoint, $branch, $log, @filetags);
                         open(STDERR, '>/dev/null'); # rlog may complain; ignore.    my ($rev, $revision, $revwanted, $filename, $head, $author, $keywordsubst);
                         openOutputFilter();  
                         exec($CMD{rlog}, @files) or exit -1;  
                 }  
         } else {  
   
                 if (!open($fh, "-|")) {    # child    while (<$fh>) {
                         open(STDERR, '>/dev/null'); # rlog may complain; ignore.      if ($state eq "start") {
                         openOutputFilter();  
                         exec($CMD{rlog}, '-r', @files) or exit -1;  
                 }  
         }  
         $state = "start";  
   
         while (<$fh>) {        #Next file. Initialize file variables
                 if ($state eq "start") {        $rev         = '';
         $revwanted   = '';
         $branch      = '';
         $branchpoint = '';
         $filename    = '';
         $log         = '';
         $revision    = '';
         %symrev      = ();
         @filetags    = ();
         $keywordsubst= '';
   
                         #Next file. Initialize file variables        #jump to head state
                         $rev         = '';        $state = "head";
                         $revwanted   = '';      }
                         $branch      = '';  
                         $branchpoint = '';  
                         $filename    = '';  
                         $log         = '';  
                         $revision    = '';  
                         %symrev      = ();  
                         @filetags    = ();  
   
                         #jump to head state      again:
                         $state = "head";  
                 }  
                 print "$state:$_" if ($verbose);  
                 again:  
   
                 if ($state eq "head") {      if ($state eq "head") {
   
                         #$rcsfile = $1 if (/^RCS file: (.+)$/); #not used (yet)        #$rcsfile = $1 if (/^RCS file: (.+)$/); #not used (yet)
   
                         if (/^Working file: (.+)$/) {        if (/^Working file: (.+)$/) {
                                 $filename = $1;          $filename = $1;
                         } elsif (/^head: (.+)$/) {        } elsif (/^head: (.+)$/) {
                                 $head = $1;          $head = $1;
                         } elsif (/^branch: (.+)$/) {        } elsif (/^branch: (.+)$/) {
                                 $branch = $1          $branch = $1;
                         } elsif (/^symbolic names:/) {        } elsif (/^keyword substitution: (.+)$/) {
                                 $state = "tags";          $keywordsubst = $1;
                                 ($branch = $head) =~ s/\.\d+$//        } elsif (/^symbolic names:/) {
                                     if $branch eq '';          $state = "tags";
                                 $branch =~ s/(\d+)$/0.$1/;          ($branch = $head) =~ s/\.\d+$//
                                 $symrev{MAIN}  = $branch;            if $branch eq '';
                                 $symrev{HEAD}  = $branch;          $branch =~ s/(\d+)$/0.$1/;
                                 $alltags{MAIN} = 1;          $symrev{MAIN}  = $branch;
                                 $alltags{HEAD} = 1;          $symrev{HEAD}  = $branch;
                                 push (@filetags, "MAIN", "HEAD");          $alltags{MAIN} = 1;
                         } elsif (/$LOG_REVSEPARATOR/o) {          $alltags{HEAD} = 1;
                                 $state = "log";          push (@filetags, "MAIN", "HEAD");
                                 $rev   = '';        } elsif ($_ =~ LOG_REVSEPR) {
                                 $date  = '';          $state = "log";
                                 $log   = '';          $rev   = '';
           $date  = '';
           $log   = '';
   
                                 # Try to reconstruct the relative filename if RCS spits out a full path          # Try to reconstruct the relative filename if RCS spits out a full path
                                 $filename =~ s%^\Q$DirName\E/%%;          $filename =~ s%^\Q$DirName\E/%%;
                         }        }
                         next;        next;
                 }      }
   
                 if ($state eq "tags") {      if ($state eq "tags") {
                         if (/^\s+([^:]+):\s+([\d\.]+)\s*$/) {        if (/^\s+([^:]+):\s+([\d\.]+)\s*$/) {
                                 push (@filetags, $1);          push (@filetags, $1);
                                 $symrev{$1}  = $2;          $symrev{$1}  = $2;
                                 $alltags{$1} = 1;          $alltags{$1} = 1;
                                 next;          next;
                         } elsif (/^\S/) {        } elsif (/^\S/) {
   
                                 if (defined($tag)) {          if (defined($tag)) {
                                         if (defined($symrev{$tag})            if (defined($symrev{$tag}) || $tag eq "HEAD") {
                                             || $tag eq "HEAD")              $revwanted    = $symrev{$tag eq "HEAD" ? "MAIN" : $tag};
                                         {              ($branch      = $revwanted) =~ s/\b0\.//;
                                                 $revwanted =              ($branchpoint = $branch)    =~ s/\.?\d+$//;
                                                     $symrev{$tag eq "HEAD" ?              $revwanted    = '' if ($revwanted ne $branch);
                                                     "MAIN" : $tag};            } elsif ($tag ne "HEAD") {
                                                 ($branch = $revwanted) =~              $state = "skip";
                                                     s/\b0\.//;              next;
                                                 ($branchpoint = $branch) =~            }
                                                     s/\.?\d+$//;          }
                                                 $revwanted = ''  
                                                     if ($revwanted ne $branch);  
                                         } elsif ($tag ne "HEAD") {  
                                                 print  
                                                     "Tag not found, skip this file"  
                                                     if ($verbose);  
                                                 $state = "skip";  
                                                 next;  
                                         }  
                                 }  
   
                                 foreach my $tagfound (@filetags) {          foreach my $tagfound (@filetags) {
                                         $tags{$tagfound} = 1;            $tags{$tagfound} = 1;
                                 }          }
                                 $state = "head";          $state = "head";
                                 goto again;          goto again;
                         }        }
                 }      }
   
                 if ($state eq "log") {      if ($state eq "log") {
                         if (/$LOG_REVSEPARATOR/o || /$LOG_FILESEPARATOR/o) {        if ($_ =~ LOG_REVSEPR || $_ =~ LOG_FILESEPR) {
   
                                 # End of a log entry.          # End of a log entry.
                                 my $revbranch = $rev;          my $revbranch = $rev;
                                 $revbranch =~ s/\.\d+$//;          $revbranch =~ s/\.\d+$//;
                                 print "$filename $rev Wanted: $revwanted ",  
                                     "Revbranch: $revbranch Branch: $branch ",  
                                     "Branchpoint: $branchpoint\n"  
                                     if ($verbose);  
   
                                 if ($revwanted eq '' && $branch ne ''          if ($revwanted eq '' && $branch ne '' && $branch eq $revbranch
                                     && $branch eq $revbranch || !defined($tag))              || !defined($tag))
                                 {          {
                                         print            $revwanted = $rev;
                                             "File revision $rev found for branch $branch\n"          }
                                             if ($verbose);  
                                         $revwanted = $rev;  
                                 }  
   
                                 if ($revwanted ne '' ? $rev eq $revwanted :          if ($revwanted ne ''
                                     $branchpoint ne '' ? $rev eq $branchpoint :              ? $rev eq $revwanted
                                     0 && ($rev eq $head))              : $branchpoint ne ''
                                 {    # Don't think head is needed here..                ? $rev eq $branchpoint
                                         print                : 0
                                             "File info $rev found for $filename\n"              && ($rev eq $head))
                                             if ($verbose);          {    # Don't think head is needed here..
                                         my @finfo =            my @finfo = ($rev, $date, $log, $author, $filename, $keywordsubst);
                                             ($rev, $date, $log, $author,            (my $name = $filename) =~ s%/.*%%;
                                                 $filename);            $fileinfo{$name} = [@finfo];
                                         my ($name);            $state = "done" if ($rev eq $revwanted);
                                         ($name = $filename) =~ s%/.*%%;          }
                                         $fileinfo{$name} = [@finfo];          $rev  = '';
                                         $state = "done" if ($rev eq $revwanted);          $date = '';
                                 }          $log  = '';
                                 $rev  = '';        } elsif ($date eq ''
                                 $date = '';                 && m|^date:\s+(\d+)/(\d+)/(\d+)\s+(\d+):(\d+):(\d+);|)
                                 $log  = '';        {
                         } elsif ($date eq ''          my $yr    = $1;
                             && m|^date:\s+(\d+)/(\d+)/(\d+)\s+(\d+):(\d+):(\d+);|          $yr      -= 1900 if ($yr > 100); # Damn 2-digit year routines :-)
                             )          $date     = timegm($6, $5, $4, $3, $2 - 1, $yr);
                         {          ($author) = /author: ([^;]+)/;
                                 my $yr = $1;          $state    = 'log';
           $log      = '';
           next;
         } elsif ($rev eq '' && /^revision (\d+(?:\.\d+)+).*$/) {
           $rev = $1;    # .*$ eats up the locker(lockers?) info, if any
           next;
         } else {
           $log .= $_;
         }
       }
   
                                 # damn 2-digit year routines :-)      if ($_ =~ LOG_FILESEPR) {
                                 if ($yr > 100) {        $state = "start";
                                         $yr -= 1900;        next;
                                 }      }
                                 $date =    }
                                     &Time::Local::timegm($6, $5, $4, $3, $2 - 1,  
                                         $yr);  
                                 ($author) = /author: ([^;]+)/;  
                                 $state = "log";  
                                 $log   = '';  
                                 next;  
                         } elsif ($rev eq '' && /^revision (\d+(?:\.\d+)+).*$/) {  
                                 $rev = $1; # .*$ eats up the locker(lockers?) info, if any  
                                 next;  
                         } else {  
                                 $log .= $_;  
                         }  
                 }  
   
                 if (/$LOG_FILESEPARATOR/o) {    my $linesread = $. || 0;
                         $state = "start";    close($fh);
                         next;  
                 }  
         }  
   
         if ($. == 0) {    if ($linesread == 0) {
                 fatal("500 Internal Error",      fatal('500 Internal Error',
                       'Failed to spawn GNU rlog on <em>"%s"</em>.  <p>Did you set the <b>$command_path</b> in your configuration file correctly ? (Currently "%s"',            '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>")',
                       join (", ", @files), $command_path);            htmlquote(join(', ', @files)), join(':', @command_path));
         }    }
         close($fh);  
     return @unreadable;
 }  }
   
 sub readLog($;$) {  
         my ($fullname, $revision) = @_;  
         my ($symnames, $head, $rev, $br, $brp, $branch, $branchrev);  
         my $fh = do { local (*FH); };  
   
         if (defined($revision)) {  sub readLog($;$)
                 $revision = "-r$revision";  {
         } else {    my ($fullname, $revision) = @_;
                 $revision = "";    my ($symnames, $head, $rev, $br, $brp, $branch, $branchrev);
         }  
   
         undef %symrev;    undef %symrev;
         undef %revsym;    undef %revsym;
         undef @allrevisions;    undef @allrevisions;
         undef %date;    undef %date;
         undef %author;    undef %author;
         undef %state;    undef %state;
         undef %difflines;    undef %difflines;
         undef %log;    undef %log;
     $keywordsubstitution = '';
   
         print("Going to rlog '$fullname'\n") if ($verbose);    my $fh = do { local (*FH); };
         if (!open($fh, "-|")) {    # child    if (!open($fh, "-|")) {    # child
                 if ($revision ne '') {      openOutputFilter();
                         openOutputFilter();      $revision = defined($revision) ? "-r$revision" : '';
                         exec($CMD{rlog}, $revision, $fullname) or exit -1;      if ($revision =~ /\./) {
                 } else {        # Normal revision, not a branch/tag name.
                         openOutputFilter();        exec($CMD{rlog}, $revision, $fullname) or exit -1;
                         exec($CMD{rlog}, $fullname) or exit -1;      } else {
                 }        exec($CMD{rlog}, $fullname) or exit -1;
         }      }
     }
   
         while (<$fh>) {    my $curbranch = undef;
                 print if ($verbose);    while (<$fh>) {
                 if ($symnames) {      if ($symnames) {
                         if (/^\s+([^:]+):\s+([\d\.]+)/) {        if (/^\s+([^:]+):\s+([\d\.]+)/) {
                                 $symrev{$1} = $2;          $symrev{$1} = $2;
                         } else {          next;
                                 $symnames = 0;        } else {
                         }          $symnames = 0;
                 } elsif (/^head:\s+([\d\.]+)/) {        }
                         $head = $1;      }
                 } elsif (/^branch:\s+([\d\.]+)/) {      if (/^head:\s+([\d\.]+)/) {
                         $curbranch = $1;        $head = $1;
                 } elsif (/^symbolic names/) {      } elsif (/^branch:\s+([\d\.]+)/) {
                         $symnames = 1;        $curbranch = $1;
                 } elsif (/^-----/) {      } elsif (/^symbolic names/) {
                         last;        $symnames = 1;
                 }      } elsif (/^keyword substitution: (.+)$/) {
         }        $keywordsubstitution = $1;
         ($curbranch = $head) =~ s/\.\d+$// if (!defined($curbranch));      } elsif (/^-----/) {
         last;
       }
     }
     ($curbranch = $head) =~ s/\.\d+$// if (!defined($curbranch));
   
         # each log entry is of the form:    # each log entry is of the form:
         # ----------------------------    # ----------------------------
         # revision 3.7.1.1    # revision 3.7.1.1
         # date: 1995/11/29 22:15:52;  author: fenner;  state: Exp;  lines: +5 -3    # date: 1995/11/29 22:15:52;  author: fenner;  state: Exp;  lines: +5 -3
         # log info    # log info
         # ----------------------------    # ----------------------------
   
         # For a locked revision, the first line after the separator    # For a locked revision, the first line after the separator
         # becomes smth like    # becomes smth like
         # revision 9.19 locked by: vassilii;    # revision 9.19       locked by: vassilii;
   
         logentry:    logentry:
   
         while (!/$LOG_FILESEPARATOR/o) {    while ($_ !~ LOG_FILESEPR) {
                 $_ = <$fh>;      $_ = <$fh>;
                 last logentry if (!defined($_));    # EOF      last logentry if (!defined($_));    # EOF
                 print "R:", $_ if ($verbose);      if (/^revision (\d+(?:\.\d+)+)/) {
                 if (/^revision (\d+(?:\.\d+)+)/) {        $rev = $1;
                         $rev = $1;        unshift(@allrevisions, $rev);
                         unshift (@allrevisions, $rev);      } elsif ($_ =~ LOG_FILESEPR || $_ =~ LOG_REVSEPR) {
                 } elsif (/$LOG_FILESEPARATOR/o || /$LOG_REVSEPARATOR/o) {        next logentry;
                         next logentry;      } else {
                 } else {  
   
                         # The rlog output is syntactically ambiguous.  We must        # The rlog output is syntactically ambiguous.  We must
                         # have guessed wrong about where the end of the last log        # have guessed wrong about where the end of the last log
                         # message was.        # message was.
                         # Since this is likely to happen when people put rlog output        # Since this is likely to happen when people put rlog output
                         # in their commit messages, don't even bother keeping        # in their commit messages, don't even bother keeping
                         # these lines since we don't know what revision they go with        # these lines since we don't know what revision they go with
                         # any more.        # any more.
                         next logentry;        next logentry;
                 }      }
                 $_ = <$fh>;      $_ = <$fh>;
                 print "D:", $_ if ($verbose);      if (
                 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+-]+))?|
                     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;
                         my $yr = $1;        $yr             -= 1900 if ($yr > 100); # Damn 2-digit year routines :-)
         $date{$rev}      = timegm($6, $5, $4, $3, $2 - 1, $yr);
         $author{$rev}    = $7;
         $state{$rev}     = $8;
         $difflines{$rev} = $10;
       } else {
         fatal("500 Internal Error", 'Error parsing RCS output: %s', $_);
       }
   
                         # damn 2-digit year routines :-)    line:
                         if ($yr > 100) {      while (<$fh>) {
                                 $yr -= 1900;        next line if (/^branches:\s/);
                         }        last line if ($_ =~ LOG_FILESEPR || $_ =~ LOG_REVSEPR);
                         $date{$rev} =        $log{$rev} .= $_;
                             &Time::Local::timegm($6, $5, $4, $3, $2 - 1, $yr);      }
                         $author{$rev}    = $7;    }
                         $state{$rev}     = $8;    close($fh);
                         $difflines{$rev} = $10;  
                 } else {  
                         fatal("500 Internal Error",  
                               'Error parsing RCS output: %s',  
                               $_);  
                 }  
                 line:  
   
                 while (<$fh>) {    @revorder = reverse sort { revcmp($a, $b) } @allrevisions;
                         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;    #
         print "Done sorting revisions", join (" ", @revorder), "\n"    # HEAD is an artificial tag which is simply the highest tag number on the main
             if ($verbose);    # 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) {
         # HEAD is an artificial tag which is simply the highest tag number on the main      if ($rev =~ /^(\S*)\.\d+$/ && $headrev eq $1) {
         # branch, unless there is a branch tag in the RCS file in which case it's the        $symrev{HEAD} = $rev;
         # highest revision on that branch.  Find it by looking through @revorder; it        last;
         # 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{HEAD} = $headrev) =~ s/\.\d+$// unless defined($symrev{HEAD});
         ($symrev{"MAIN"} = $headrev) =~ s/(\d+)$/0.$1/;  
   
         foreach $rev (@revorder) {    #
                 if ($rev =~ /^(\S*)\.\d+$/ && $headrev eq $1) {    # Now that we know all of the revision numbers, we can associate
                         $symrev{"HEAD"} = $rev;    # absolute revision numbers with all of the symbolic names, and
                         last;    # pass them to the form so that the same association doesn't have
                 }    # to be built then.
         }    #
         ($symrev{"HEAD"} = $headrev) =~ s/\.\d+$//    undef @branchnames;
             if (!defined($symrev{"HEAD"}));    undef %branchpoint;
         print "Done finding HEAD\n" if ($verbose);    undef $sel;
   
         #    foreach (reverse sort keys %symrev) {
         # Now that we know all of the revision numbers, we can associate      $rev = $symrev{$_};
         # absolute revision numbers with all of the symbolic names, and      if ($rev =~ /^((.*)\.)?\b0\.(\d+)$/) {
         # pass them to the form so that the same association doesn't have        push (@branchnames, $_);
         # to be built then.  
         #  
         undef @branchnames;  
         undef %branchpoint;  
         undef $sel;  
   
         foreach (reverse sort keys %symrev) {        #
                 $rev = $symrev{$_};        # A revision number of A.B.0.D really translates into
                 if ($rev =~ /^((.*)\.)?\b0\.(\d+)$/) {        # "the highest current revision on branch A.B.D".
                         push (@branchnames, $_);        #
         # 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';
                         # A revision number of A.B.0.D really translates into        $regex = qr/$regex/;
                         # "the highest current revision on branch A.B.D".  
                         #  
                         # If there is no branch A.B.D, then it translates into  
                         # the head A.B .  
                         #  
                         # This reasoning also applies to the main branch A.B,  
                         # with the branch number 0.A, with the exception that  
                         # it has no head to translate to if there is nothing on  
                         # the branch, but I guess this can never happen?  
                         #  
                         # (the code below gracefully forgets about the branch  
                         # if it should happen)  
                         #  
                         $head = defined($2) ? $2 : "";  
                         $branch = $3;  
                         $branchrev = $head . ($head ne "" ? "." : "") . $branch;  
                         my $regex;  
                         $regex = quotemeta $branchrev;  
                         $rev   = $head;  
   
                         foreach my $r (@revorder) {        foreach my $r (@revorder) {
                                 if ($r =~ /^${regex}\b/) {          if ($r =~ $regex) {
                                         $rev = $branchrev;            $rev = $branchrev;
                                         last;            last;
                                 }          }
                         }        }
                         next if ($rev eq "");        next if ($rev eq "");
   
                         if ($rev ne $head && $head ne "") {        if ($rev ne $head && $head ne "") {
                                 $branchpoint{$head} .= ", "          $branchpoint{$head} .= ', ' if ($branchpoint{$head});
                                     if ($branchpoint{$head});          $branchpoint{$head} .= $_;
                                 $branchpoint{$head} .= $_;        }
                         }      }
                 }      $revsym{$rev} .= ", " if ($revsym{$rev});
                 $revsym{$rev} .= ", " if ($revsym{$rev});      $revsym{$rev} .= $_;
                 $revsym{$rev} .= $_;      $sel .= sprintf("<option value=\"%s:%s\">%s</option>\n",
                 $sel .= "<option value=\"${rev}:${_}\">$_</option>\n";                      htmlquote($rev), (htmlquote($_)) x 2);
         }    }
         print "Done associating revisions with branches\n" if ($verbose);  
   
         my ($onlyonbranch, $onlybranchpoint);    my ($onlyonbranch, $onlybranchpoint);
         if ($onlyonbranch = $input{'only_with_tag'}) {    if ($onlyonbranch = $input{only_with_tag}) {
                 $onlyonbranch = $symrev{$onlyonbranch};      $onlyonbranch = $symrev{$onlyonbranch};
                 if ($onlyonbranch =~ s/\b0\.//) {      if ($onlyonbranch && $onlyonbranch =~ s/\b0\.//) {
                         ($onlybranchpoint = $onlyonbranch) =~ s/\.\d+$//;        ($onlybranchpoint = $onlyonbranch) =~ s/\.\d+$//;
                 } else {      } else {
                         $onlybranchpoint = $onlyonbranch;        $onlybranchpoint = $onlyonbranch;
                 }      }
   
                 if (!defined($onlyonbranch) || $onlybranchpoint eq "") {      if (!defined($onlyonbranch) || $onlybranchpoint eq "") {
                         fatal("404 Tag not found",        fatal("404 Tag not found", 'Tag "<code>%s</code>" is not defined.',
                               'Tag %s not defined',              $input{only_with_tag});
                               $input{'only_with_tag'});      }
                 }    }
         }  
   
         undef @revisions;    undef @revisions;
   
         foreach (@allrevisions) {    foreach (@allrevisions) {
                 ($br  = $_)  =~ s/\.\d+$//;      ($br  = $_)  =~ s/\.\d+$//;
                 ($brp = $br) =~ s/\.\d+$//;      ($brp = $br) =~ s/\.\d+$//;
                 next      next if ($onlyonbranch
                     if ($onlyonbranch && $br ne $onlyonbranch               && $br ne $onlyonbranch
                     && $_ ne $onlybranchpoint);               && $_  ne $onlybranchpoint);
                 unshift (@revisions, $_);      unshift(@revisions, $_);
         }    }
   
         if ($logsort eq "date") {    if ($logsort eq "date") {
   
                 # Sort the revisions in commit order an secondary sort on revision      # Sort the revisions in commit order an secondary sort on revision
                 # (secondary sort needed for imported sources, or the first main      # (secondary sort needed for imported sources, or the first main
                 # revision gets before the same revision on the 1.1.1 branch)      # revision gets before the same revision on the 1.1.1 branch)
                 @revdisplayorder =      @revdisplayorder =
                     sort { $date{$b} <=> $date{$a} || -revcmp($a, $b) }        sort { $date{$b} <=> $date{$a} || -revcmp($a, $b) } @revisions;
                     @revisions;    } elsif ($logsort eq "rev") {
         } elsif ($logsort eq "rev") {  
   
                 # Sort the revisions in revision order, highest first      # Sort the revisions in revision order, highest first
                 @revdisplayorder = reverse sort { revcmp($a, $b) } @revisions;      @revdisplayorder = reverse sort { revcmp($a, $b) } @revisions;
         } else {    } else {
   
                 # No sorting. Present in the same order as rlog / cvs log      # No sorting. Present in the same order as rlog / cvs log
                 @revdisplayorder = @revisions;      @revdisplayorder = @revisions;
         }    }
   
     return $curbranch;
 }  }
   
 sub printDiffLinks($$) {  
         my ($text, $url) = @_;  
         my @extra;  
   
         local $_;  sub getDiffLinks($$$)
         for ($DIFFTYPES{$defaultDiffType}{'colored'} ? qw(u) : qw(h)) {  {
                 my $f = $_ eq $defaultDiffType ? '' : $_;    my ($url, $mimetype, $isbin) = @_;
   
                 push @extra, &link(lc $DIFFTYPES{$_}{'descr'}, "$url&f=$f");    my @links = ();
         }    if (!$isbin) { # Offer ordinary diff only for non-binary files.
       push(@links, &link('preferred', $url));
         print &link($text, $url), ' (', join (', ', @extra), ')';      for my $difftype ($DIFFTYPES{$defaultDiffType}{colored} ? qw(u) : qw(h)) {
         my $f = $difftype eq $defaultDiffType ? '' : $difftype;
         push(@links,
              &link(htmlquote(lc($DIFFTYPES{$difftype}{descr})), "$url;f=$f"));
       }
     }
     if (my $extdiffs = $DIFF_COMMANDS{lc($mimetype)}) {
       for my $i (0 .. scalar(@$extdiffs)-1) {
         my $extdiff = $extdiffs->[$i];
         push(@links, &link(htmlquote($extdiff->{name}), "$url;f=ext$i"))
           if ($extdiff->{cmd} && $extdiff->{name});
       }
     }
     return @links;
 }  }
   
 sub printLog($;$) {  
         my ($link, $br, $brp);  
         ($_, $link) = @_;  
         ($br  = $_)  =~ s/\.\d+$//;  
         ($brp = $br) =~ s/\.?\d+$//;  
         my ($isDead, $prev);  
   
         $link = 1 if (!defined($link));  sub printLog($$$;$$)
         $isDead = ($state{$_} eq "dead");  {
     # inlogview: 1 if in log view, otherwise in markup view.
     ($_, my $mimetype, my $isbin, my $inlogview, my $isSelected) = @_;
     (my $br  = $_)  =~ s/\.\d+$//;
     (my $brp = $br) =~ s/\.?\d+$//;
   
         print "<p>\n";    print "<a name=\"rev$_\"></a>";
         if ($link && !$isDead) {    if (defined($revsym{$_})) {
                 my ($filename);      foreach my $sym (split(", ", $revsym{$_})) {
                 ($filename = $where) =~ s/^.*\///;        print '<a name="', htmlquote($sym), '"></a>';
                 my ($fileurl) = urlencode($filename);      }
                 print "<a name=\"rev$_\"></a>";    }
     if ($revsym{$br} && !defined($nameprinted{$br})) {
       foreach my $sym (split(", ", $revsym{$br})) {
         print '<a name="', htmlquote($sym), '"></a>';
       }
       $nameprinted{$br} = 1;
     }
   
                 if (defined($revsym{$_})) {    print "\n Revision <b>$_</b>";
                         foreach my $sym (split (", ", $revsym{$_})) {    if (/^1\.1\.1\.\d+$/) {
                                 print "<a name=\"$sym\"></a>";      print " <i>(vendor branch)</i>";
                         }    }
                 }  
   
                 if (defined($revsym{$br}) && $revsym{$br}    (my $filename = $where) =~ s|^.*/||;
                     && !defined($nameprinted{$br}))    my $fileurl   = uri_escape($filename);
                 {    undef $filename;
                         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) {    my $isDead = ($state{$_} eq 'dead');
                         print " / (";    if (!$isDead) {
                         &download_link($fileurl, $_, "download", $mimetype);  
                         print ")";  
                 }  
   
                 if (not $defaultTextPlain) {      print ': ', download_link($fileurl, $_, 'download', $mimetype);
                         print " / (";  
                         &download_link($fileurl, $_, "as text", "text/plain");  
                         print ")";  
                 }  
   
                 if (!$defaultViewable) {      my @vlinks = ();
                         print " / (";      push(@vlinks, display_link($fileurl, $_, 'text', 'text/plain'))
                         &download_link($fileurl, $_, "view",        unless $isbin;
                                 "text/x-cvsweb-markup");      push(@vlinks, display_link($fileurl, $_, 'markup', 'text/x-cvsweb-markup'))
                         print ")";        if ($allow_markup && $inlogview && (!$isbin || viewable($mimetype)));
                 }      if (!$isbin && $allow_annotate) {
         push(@vlinks,
              &link('annotated',
                    sprintf('%s?annotate=%s%s', $fileurl, $_, $barequery)));
       }
       print ' - view: ', join(', ', @vlinks) if @vlinks;
       undef @vlinks;
   
                 if ($allow_annotate) {      if (!$isbin && $allow_version_select) {
                         print " - ";        print ' - ';
                         print &link(        if ($isSelected) {
                                 'annotate',          print '<b>[selected&nbsp;for&nbsp;diffs]</b>';
                                 sprintf(        } else {
                                         '%s/%s?annotate=%s%s', $scriptname,          print &link('select&nbsp;for&nbsp;diffs',
                                         urlencode($where),     $_,                      sprintf('%s?r1=%s%s#rev%s',
                                         $barequery                              $fileurl, $_, $barequery, $_));
                                 )        }
                         );      }
                 }      print ' - ', graph_link('', 'revision graph')
         if (!$inlogview && $allow_cvsgraph);
     }
     print "<br />\n";
   
                 # Plus a select link if enabled, and this version isn't selected    print '<i>';
                 if ($allow_version_select) {    if (defined @mytz) {
                         if ((!defined($input{"r1"}) || $input{"r1"} ne $_)) {      my ($est) = $mytz[(localtime($date{$_}))[8]];
                                 print " - ";      print scalar localtime($date{$_}), " $est</i> (";
                                 print &link(    } else {
                                         '[select for diffs]',      print scalar gmtime($date{$_}), " UTC</i> (";
                                         sprintf(    }
                                                 '%s?r1=%s%s', $scriptwhere,    print readableTime(time() - $date{$_}, 1), ' ago)';
                                                 $_,           $barequery    print ' by <i>', htmlquote($author{$_}), "</i><br />\n";
                                         )  
                                 );  
                         } else {  
                                 print " - <b>[selected]</b>";  
                         }  
                 }  
         } else {  
                 print "Revision <b>$_</b>";  
         }  
   
         if (/^1\.1\.1\.\d+$/) {    printf("Branches: %s<br />\n", link_tags($revsym{$br})) if $revsym{$br};
                 print " <i>(vendor branch)</i>";    printf("CVS tags: %s<br />\n", link_tags($revsym{$_}))  if $revsym{$_};
         }    printf("Branch point for: %s<br />\n", link_tags($branchpoint{$_}))
         if (defined @mytz) {      if $branchpoint{$_};
                 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    # Find the previous revision
         my @prevrev = split (/\./, $_);    my $prev;
         do {    my @prevrev = split(/\./, $_);
                 if (--$prevrev[$#prevrev] <= 0) {    do {
       if (--$prevrev[$#prevrev] <= 0) {
   
                         # If it was X.Y.Z.1, just make it X.Y        # If it was X.Y.Z.1, just make it X.Y
                         pop (@prevrev);        pop (@prevrev);
                         pop (@prevrev);        pop (@prevrev);
                 }      }
                 $prev = join (".", @prevrev);      $prev = join (".", @prevrev);
         } until (defined($date{$prev}) || $prev eq "");    } until (defined($date{$prev}) || $prev eq "");
   
         if ($prev ne "") {    if ($isDead) {
                 if ($difflines{$_}) {      print "<b><i>FILE REMOVED</i></b><br />\n";
                         print    } else {
                             "<br>Changes since <b>$prev: $difflines{$_} lines</b>";      my %diffrev = ();
                 }      $diffrev{$_} = 1;
         }      $diffrev{""} = 1;
       my $diff = 'Diff to:';
       my $printed = 0;
   
         if ($isDead) {      #
                 print "<br><b><i>FILE REMOVED</i></b>\n";      # Offer diff to previous revision
         } elsif ($link) {      if ($prev) {
                 my %diffrev = ();        $diffrev{$prev} = 1;
                 $diffrev{$_} = 1;        my $url =
                 $diffrev{""} = 1;          sprintf('%s.diff?r1=%s;r2=%s%s', $fileurl, $prev, $_, $barequery);
                 print '<br>';        if (my @dlinks = getDiffLinks($url, $mimetype, $isbin)) {
                 my $diff = 'Diff';          print $diff, ' previous ', $prev, ': ', join(', ', @dlinks);
           $diff = ';'; $printed = 1;
         }
       }
   
                 #      #
                 # Offer diff to previous revision      # Plus, if it's on a branch, and it's not a vendor branch,
                 if ($prev) {      # offer a diff with the branch point.
                         $diffrev{$prev} = 1;      if ($revsym{$brp}
         && !/^1\.1\.1\.\d+$/
         && !defined($diffrev{$brp}))
       {
         my $url =
           sprintf('%s.diff?r1=%s;r2=%s%s', $fileurl, $brp, $_, $barequery);
         if (my @dlinks = getDiffLinks($url, $mimetype, $isbin)) {
           print $diff, ' branchpoint ', $brp, ': ', join(', ', @dlinks);
           $diff = ';'; $printed = 1;
         }
       }
   
                         my $url =      #
                             sprintf('%s.diff?r1=%s&r2=%s%s', $scriptwhere,      # Plus, if it's on a branch, and it's not a vendor branch,
                                 $prev, $_, $barequery);      # offer to diff with the next revision of the higher branch.
       # (e.g. change gets committed and then brought
       # over to -stable)
       if (/^\d+\.\d+\.\d+/ && !/^1\.1\.1\.\d+$/) {
         my ($i, $nextmain);
   
                         print $diff, " to previous ";        for ($i = 0; $i < $#revorder && $revorder[$i] ne $_; $i++) {
                         $diff = '';        }
                         printDiffLinks($prev, $url);        my @tmp2 = split(/\./, $_);
                 }        for ($nextmain = ""; $i > 0; $i--) {
           my $next = $revorder[$i - 1];
           my @tmp1 = split(/\./, $next);
   
                 #          if (@tmp1 < @tmp2) {
                 # Plus, if it's on a branch, and it's not a vendor branch,            $nextmain = $next;
                 # offer a diff with the branch point.            last;
                 if ($revsym{$brp} && !/^1\.1\.1\.\d+$/          }
                     && !defined($diffrev{$brp}))  
                 {  
                         my $url =  
                             sprintf('%s.diff?r1=%s&r2=%s%s', $scriptwhere, $brp,  
                                 $_, $barequery);  
   
                         print $diff, " to branchpoint ";          # Only the highest version on a branch should have
                         $diff = '';          # a diff for the "next MAIN".
                         printDiffLinks($brp, $url);          last
                 }            if (@tmp1 - 1 <= @tmp2
             && join (".", @tmp1[0 .. $#tmp1 - 1]) eq
             join (".", @tmp2[0 .. $#tmp1 - 1]));
         }
   
                 #        if (!defined($diffrev{$nextmain})) {
                 # Plus, if it's on a branch, and it's not a vendor branch,          $diffrev{$nextmain} = 1;
                 # offer to diff with the next revision of the higher branch.          my $url = sprintf('%s.diff?r1=%s;r2=%s%s',
                 # (e.g. change gets committed and then brought            $fileurl, $nextmain, $_, $barequery);
                 # over to -stable)          if (my @dlinks = getDiffLinks($url, $mimetype, $isbin)) {
                 if (/^\d+\.\d+\.\d+/ && !/^1\.1\.1\.\d+$/) {            print $diff, ' next MAIN ', $nextmain, ': ', join(', ', @dlinks);
                         my ($i, $nextmain);            $diff = ';'; $printed = 1;
           }
         }
       }
   
                         for ($i = 0 ; $i < $#revorder && $revorder[$i] ne $_ ;      # Plus if user has selected only r1, then present a link
                             $i++)      # to make a diff to that revision
                         {      if (defined($input{r1}) && !defined($diffrev{$input{r1}})) {
                         }        $diffrev{$input{r1}} = 1;
                         my @tmp2 = split (/\./, $_);        my $url = sprintf('%s.diff?r1=%s;r2=%s%s',
                         for ($nextmain = "" ; $i > 0 ; $i--) {          $fileurl, $input{r1}, $_, $barequery);
                                 my $next = $revorder[$i - 1];        if (my @dlinks = getDiffLinks($url, $mimetype, $isbin)) {
                                 my @tmp1 = split (/\./, $next);          print $diff, ' selected ', $input{r1}, ': ', join(', ', @dlinks);
           $diff = ';'; $printed = 1;
         }
       }
   
                                 if (@tmp1 < @tmp2) {      print "<br />\n" if $printed;
                                         $nextmain = $next;    }
                                         last;  
                                 }  
   
                                 # Only the highest version on a branch should have    if ($prev ne "" && $difflines{$_}) {
                                 # a diff for the "next main".      printf "Changes since revision %s: %s lines<br />\n",
                                 last        htmlquote($prev), htmlquote($difflines{$_});
                                     if (@tmp1 - 1 <= @tmp2    }
                                     && join (".", @tmp1[0 .. $#tmp1 - 1]) eq  
                                     join (".", @tmp2[0 .. $#tmp1 - 1]));  
                         }  
   
                         if (!defined($diffrev{$nextmain})) {    print "<pre class=\"log\">\n";
                                 $diffrev{$nextmain} = 1;    print &htmlify($log{$_}, $allow_log_extra);
     print "</pre>\n";
   }
   
                                 my $url =  
                                     sprintf('%s.diff?r1=%s&r2=%s%s',  
                                         $scriptwhere, $nextmain, $_,  
                                         $barequery);  
   
                                 print $diff, " next main ";  #
                                 $diff = '';  # Generates the HTML view for CvsGraph.
                                 printDiffLinks($nextmain, $url);  #
                         }  sub doGraphView()
                 }  {
     (my $pathname = $where) =~ s|[^/]*$||;
     (my $filename = $where) =~ s|^.*/||;
   
                 # Plus if user has selected only r1, then present a link    navigateHeader($scriptwhere, $pathname, $filename, undef, 'graph');
                 # to make a diff to that revision  
                 if (defined($input{"r1"}) && !defined($diffrev{$input{"r1"}})) {  
                         $diffrev{$input{"r1"}} = 1;  
   
                         my $url =    my $title = 'Revision graph of ' . htmlquote($pathname . $filename);
                             sprintf('%s.diff?r1=%s&r2=%s%s', $scriptwhere,    my $mapname = 'CvsGraphMap';
                                 $input{'r1'}, $_, $barequery);  
   
                         print $diff, " to selected ";    printf(<<EOF, $title, $mapname, $cvstree, $title);
                         $diff = '';  <h3 style="text-align: center">%s</h3>
                         printDiffLinks($input{'r1'}, $url);  <div style="text-align: center"><img border="0" usemap="#%s" src="?cvsroot=%s;graph=1;makeimage=1" alt="%s" />
                 }  EOF
   
         }    # Remove any pre-existing tag/branch names from branch links.
         print "\n</p>\n<pre>\n";    (my $notag_query = $barequery) =~ s/;+only_with_tag=.*?(?=;|$)//g;
         print &htmlify($log{$_}, $allow_log_extra);  
         print "</pre>\n";    my @graph_cmd =
       ($CMD{cvsgraph},
        '-r', $cvsroot,
        '-m', $pathname,
        '-i',
        '-M', $mapname,
        '-x', 'x',
        "-Omap_branch_href=\"href=\\\"./?only_with_tag=%(%t%)$notag_query\\\"\"",
        "-Omap_rev_href=\"href=\\\"?rev=%(%R%)$barequery\\\"\"",
        "-Omap_diff_href=\"href=\\\"%(%F%).diff" .
        "?r1=%(%P%);r2=%(%R%)$barequery\\\"\"",
        );
     push(@graph_cmd, '-c', $cvsgraph_config) if $cvsgraph_config;
     push(@graph_cmd, $filename . ',v');
   
     local *CVSGRAPH_OUT;
     my ($h, $err) =
       startproc(\@graph_cmd, \"", '>pipe', \*CVSGRAPH_OUT);
     fatal('500 Internal Error', $err) unless $h;
   
     # Browser compatibility kludge: many browsers do not support client side
     # image maps where the <map> element contains only the id attribute.  Let's
     # add the corresponding name attribute to it on the fly.
     while (<CVSGRAPH_OUT>) {
       s/(<map\s+id="([^"]+)")\s*>/$1 name="$2">/;
       print;
     }
   
     $h->finish();
     print "</div>\n";
   
     html_footer();
 }  }
   
 sub doLog($) {  
         my ($fullname) = @_;  
         my ($diffrev, $upwhere, $filename, $backurl);  
   
         readLog($fullname);  #
   # Generates a graph using CvsGraph.
   #
   sub doGraph()
   {
     (my $pathname = $where) =~ s|[^/]*$||;
     (my $filename = $where) =~ s|^.*/||;
   
         html_header("CVS log for $where");    http_header('image/png');
         ($upwhere  = $where) =~ s|(Attic/)?[^/]+$||;  
         ($filename = $where) =~ s|^.*/||;  
         $backurl = $scriptname . "/" . urlencode($upwhere) . $query;  
         print "<p>\n ";  
         print &link($backicon, "$backurl#$filename"), " <b>Up to ",  
             &clickablePath($upwhere, 1), "</b>\n</p>\n";  
         print "<p>\n ";  
         print &link('Request diff between arbitrary revisions', '#diff');  
         print "\n</p>\n<hr noshade>\n";  
   
         print "<p>\n";    my @graph_cmd = ($CMD{cvsgraph}, '-r', $cvsroot, '-m', $pathname);
         if ($curbranch) {    push(@graph_cmd, '-c', $cvsgraph_config) if $cvsgraph_config;
                 print "Default branch: ", ($revsym{$curbranch} || $curbranch);    push(@graph_cmd, $filename . ',v');
         } else {  
                 print "No default branch";  
         }  
         print "<br>\n";  
   
         if ($input{only_with_tag}) {    local *CVSGRAPH_OUT;
                 print "Current tag: $input{only_with_tag}<br>\n";    my ($h, $err) =
         }      startproc(\@graph_cmd, \"", '>pipe', \*CVSGRAPH_OUT);
         print "</p>\n";    fatal('500 Internal Error', $err) unless $h;
     {
       local $/ = undef;
       binmode(\*STDOUT);
       print <CVSGRAPH_OUT>;
     }
     $h->finish();
   }
   
         undef %nameprinted;  
   
         for (my $i = 0 ; $i <= $#revdisplayorder ; $i++) {  sub doLog($)
                 print "<hr size=\"1\" noshade>\n";  {
                 printLog($revdisplayorder[$i]);    my ($fullname) = @_;
         }  
   
         print "<hr noshade>\n<p>\n";    my $curbranch = readLog($fullname);
         print "<a name=\"diff\">\n";  
         print "This form allows you to request diff's between any two\n";  
         print "revisions of a file.  You may select a symbolic revision\n";  
         print "name using the selection box or you may type in a numeric\n";  
         print "name using the type-in text box.\n";  
         print "</a>\n</p>\n";  
         print  
             "<form method=\"get\" action=\"${scriptwhere}.diff\" name=\"diff_select\">\n";  
   
         foreach (@stickyvars) {    html_header("CVS log for $where");
                 printf('<input type="hidden" name="%s" value="%s">', $_,  
                     $input{$_})  
                     if (defined($input{$_})  
                     && ((!defined($DEFAULTVALUE{$_})  
                     || $input{$_} ne $DEFAULTVALUE{$_}) && $input{$_} ne ""));  
         }  
         print "<table style=\"border: none\">\n<tr>\n";  
         print "<td align=\"right\">";  
         print "<label for=\"r1\" accesskey=\"1\">Diffs between </label>\n";  
         print "<select id=\"r1\" name=\"r1\">\n";  
         print "<option value=\"text\" selected>Use Text Field</option>\n";  
         print $sel;  
         print "</select>\n";  
         $diffrev = $revdisplayorder[$#revdisplayorder];  
         $diffrev = $input{"r1"} if (defined($input{"r1"}));  
         print  
             "<input type=\"text\" size=\"$inputTextSize\" name=\"tr1\" value=\"$diffrev\" onchange=\"this.form.r1.selectedIndex=0\"></td>\n";  
         print "<td><br></td>\n</tr>\n";  
         print "<tr>\n<td align=\"right\">";  
         print "<label for=\"r2\" accesskey=\"2\">and </label>\n";  
         print "<select id=\"r2\" name=\"r2\">\n";  
         print "<option value=\"text\" selected>Use Text Field</option>\n";  
         print $sel;  
         print "</select>\n";  
         $diffrev = $revdisplayorder[0];  
         $diffrev = $input{"r2"} if (defined($input{"r2"}));  
         print  
             "<input type=\"text\" size=\"$inputTextSize\" name=\"tr2\" value=\"$diffrev\" onchange=\"this.form.r2.selectedIndex=0\"></td>\n";  
         print "<td><input type=\"submit\" value=\"  Get Diffs  \" accesskey=\"G\"></td>\n";  
         print "</tr>\n</table>\n";  
         print "</form>\n";  
         print "<hr noshade>\n";  
         print "<form method=\"get\" action=\"$scriptwhere\">\n";  
         print "<table style=\"border: none\">\n";  
         print "<tr>\n<td align=\"right\">";  
         print "<label for=\"f\" accesskey=\"D\">Preferred Diff type:";  
         print "</label></td>\n";  
         print "<td>";  
         printDiffSelect($use_java_script);  
         print "</td>\n<td></td>\n</tr>\n";  
   
         if (@branchnames) {    my $upwhere = $where;
                 print "<tr>\n<td align=\"right\">";    (my $filename = $where) =~ s|^.*/||;
                 print "<label for=\"only_with_tag\" accesskey=\"B\">";    my $backurl = "./$query#" . uri_escape($filename);
                 print "View only Branch:</label></td>\n";    if ($where =~ m|^(.*?)((?<=/)Attic/)?[^/]+$|) {
                 print "<td>";      $upwhere = $1;
                 print "<a name=\"branch\"></a>\n";      $backurl = ".$backurl" if $2; # skip over Attic
                 print "<select id=\"only_with_tag\" name=\"only_with_tag\"";    }
                 print " onchange=\"this.form.submit()\"" if $use_java_script;  
                 print ">\n";  
                 print "<option value=\"\"";  
                 print " selected"  
                     if (defined($input{"only_with_tag"})  
                     && $input{"only_with_tag"} eq "");  
                 print ">Show all branches</option>\n";  
   
                 foreach (reverse sort @branchnames) {    my $isbin = $keywordsubstitution =~ /b/;
                         print "<option";    my $mimetype = getMimeType($filename, $isbin);
                         print " selected"  
                             if (defined($input{"only_with_tag"})  
                             && $input{"only_with_tag"} eq $_);  
                         print ">${_}</option>\n";  
                 }  
                 print "</select></td>\n<td></td>\n</tr>\n";  
         }  
   
         foreach (@stickyvars) {    print "<p>\n ";
                 next if ($_ eq "f");    print &link($backicon, $backurl), " <b>Up to ",
                 next if ($_ eq "only_with_tag");      &clickablePath($upwhere, 1), "</b>\n</p>\n";
                 next if ($_ eq "logsort");    print "<p>\n ";
                 print "<input type=\"hidden\" name=\"$_\" value=\"$input{$_}\">\n"    print &link('Request diff between arbitrary revisions', '#diff');
                     if (defined($input{$_})    print ' - ', &graph_link('', 'Display revisions graphically')
                     && (!defined($DEFAULTVALUE{$_})      if $allow_cvsgraph;
                     || $input{$_} ne $DEFAULTVALUE{$_}) && $input{$_} ne "");    if ($cvshistory_url) {
         }      (my $d = $upwhere) =~ s|/+$||;
         print "<tr>\n<td align=\"right\">";      print ' - ', history_link($d, $filename);
         print "<a name=\"logsort\"></a>\n";    }
         print "<label for=\"logsort\" accesskey=\"L\">Sort log by:";    print "\n</p>\n<hr />\n";
         print "</label></td>\n<td>";  
         printLogSortSelect($use_java_script);    print "<p>\n";
         print "</td>\n";  
         print "<td><input type=\"submit\" value=\"  Set  \" accesskey=\"S\"></td>\n";    my $explain = $isbin ? ' (i.e.: CVS considers this a binary file)' : '';
         print "</tr>\n</table>\n";    print "Keyword substitution: $keywordsubstitution$explain<br />\n";
         print "</form>\n";    if ($curbranch) {
         html_footer();      print "Default branch: ", ($revsym{$curbranch} || $curbranch);
     } else {
       print "No default branch";
     }
     print "<br />\n";
   
     print 'Current tag: ', htmlquote($input{only_with_tag}), "<br />\n"
       if $input{only_with_tag};
     print "</p>\n";
   
     undef %nameprinted;
   
     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;
     }
   
     printf(<<EOF, $scriptwhere);
   <hr />
   <form method="get" action="%s.diff" id="diff_select">
   <fieldset>
   <legend>Diff request</legend>
   <p>
    <a name="diff">
     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
   
     foreach (@stickyvars) {
       printf("<input type=\"hidden\" name=\"%s\" value=\"%s\" />\n",
              $_, htmlquote($input{$_}))
         if (defined($input{$_}) &&
             (!defined($DEFAULTVALUE{$_}) || $input{$_} ne $DEFAULTVALUE{$_}));
     }
   
     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";
   
     my $diffrev = defined($input{r1}) ?
       $input{r1} : $revdisplayorder[$#revdisplayorder];
   
     printf(<<EOF, $inputTextSize, $diffrev);
   <input type="text" size="%s" name="tr1" value="%s" onchange="this.form.r1.selectedIndex=0" />
   </td>
   <td></td>
   </tr>
   <tr>
   <td class="opt-label">
   <label for="r2" accesskey="2">and</label>
   </td>
   <td class="opt-value">
   <select id="r2" name="r2">
   <option value="text" selected="selected">Use Text Field</option>
   EOF
     print $sel, "</select>\n";
   
     $diffrev = defined($input{r2}) ? $input{r2} : $revdisplayorder[0];
   
     printf(<<EOF, $inputTextSize, $diffrev, $scriptwhere);
   <input type="text" size="%s" name="tr2" value="%s" onchange="this.form.r2.selectedIndex=0" />
   </td>
   <td><input type="submit" value="Get Diffs" accesskey="G" /></td>
   </tr>
   </table>
   </fieldset>
   </form>
   <form method="get" action="%s">
   <fieldset>
   <legend>Log view options</legend>
   <table summary="Log view options">
   <tr>
   <td class="opt-label">
   <label for="f" accesskey="D">Preferred diff type:</label>
   </td>
   <td class="opt-value">
   EOF
     printDiffSelect($use_java_script);
     print <<EOF;
   </td>
   <td></td>
   </tr>
   EOF
   
     if (@branchnames) {
   
       printf(<<EOF, $use_java_script ? ' onchange="this.form.submit()"' : '');
   <tr>
   <td class="opt-label">
   <label for="only_with_tag" accesskey="B">View only branch:</label>
   </td>
   <td class="opt-value">
   <a name="branch">
   <select id="only_with_tag" name="only_with_tag"%s>
   EOF
   
       my @tmp = ();
       my $selfound = 0;
       foreach (reverse sort @branchnames) {
         my $selected =
           (defined($input{only_with_tag}) && $input{only_with_tag} eq $_);
         $selfound ||= $selected;
         push(@tmp, sprintf('<option%s>%s</option>',
                            $selected ? ' selected="selected"' : '',
                            htmlquote($_)));
       }
       printf("<option value=\"\"%s>Show all branches</option>\n",
              $selfound ? '' : ' selected="selected"');
       print join("\n", @tmp);
   
       print <<EOF
   </select>
   </a>
   </td>
   <td></td>
   </tr>
   EOF
     }
   
     print <<EOF;
   <tr>
   <td class="opt-label">
   <label for="logsort" accesskey="L">Sort log by:</label>
   </td>
   <td>
   EOF
     printLogSortSelect($use_java_script);
     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=\"$_\" 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;  
         my ($leftColRef, $rightColRef, $leftRow, $rightRow) = @_;  
   
         if (!defined($state)) {  sub flush_diff_rows($$$$)
                 return;  {
         }    my ($leftColRef, $rightColRef, $leftRow, $rightRow) = @_;
   
         if ($state eq "PreChangeRemove") {    # we just got remove-lines before    return unless defined($state);
                 for ($j = 0 ; $j < $leftRow ; $j++) {  
                         print  
                             "<tr>\n<td class=\"diff-removed\">&nbsp;@$leftColRef[$j]</td>\n";  
                         print  
                             "<td class=\"diff-empty\">&nbsp;</td>\n</tr>\n";  
                 }  
         } elsif ($state eq "PreChange") {    # state eq "PreChange"  
                     # we got removes with subsequent adds  
   
                 for ($j = 0 ; $j < $leftRow || $j < $rightRow ; $j++)    if ($state eq "PreChangeRemove") {    # we just got remove-lines before
                 {    # dump out both cols      for (my $j = 0; $j < $leftRow; $j++) {
                         print "<tr>\n";        printf(<<EOF, spacedHtmlText(@$leftColRef[$j]));
                         if ($j < $leftRow) {  <tr>
                                 print   <td class="diff diff-removed">&nbsp;%s</td>
                                     "<td class=\"diff-changed\">&nbsp;@$leftColRef[$j]</td>";   <td class="diff diff-empty">&nbsp;</td>
                         } else {  </tr>
                                 print  EOF
                                     "<td class=\"diff-changed-missing\">&nbsp;</td>";      }
                         }    } elsif ($state eq "PreChange") {     # state eq "PreChange"
                         print "\n";                                          # we got removes with subsequent adds
       if (HAS_EDIFF) {
         # construct the suffix tree
         my $left_diff = join("\n", @$leftColRef[0..$leftRow-1]);
         my $right_diff = join("\n", @$rightColRef[0..$rightRow-1]);
         my $diff_str = String::Ediff::ediff($left_diff, $right_diff);
   
                         if ($j < $rightRow) {        my @diff_str = split(/ /, $diff_str);
                                 print        my $INFINITY = 10000000;
                                     "<td class=\"diff-changed\">&nbsp;@$rightColRef[$j]</td>";        push(@diff_str, ($INFINITY) x 8);
                         } else {        my ($idx, $b1, $e1, $lb1, $le1, $b2, $e2, $lb2, $le2) =
                                 print          (0, @diff_str[0..7]);
                                     "<td class=\"diff-changed-missing\">&nbsp;</td>";        my ($l_cul, $r_cul) = (0, 0);
                         }        my ($ldx, $rdx) = (0, 0);
                         print "\n</tr>\n";        my (@left_html, @right_html);
                 }        for (my $j = 0; $j < $leftRow; $j++) {
         }          my $line_len = length(@$leftColRef[$j]);
           my $line = @$leftColRef[$j];
           $l_cul += length($line) + 1; # includes "\n"
           my $l_culx = $l_cul - 1; # not includes "\n"
           if ($j < $lb1) {
             $line = spacedHtmlText($line);
             push(@left_html, "<td class=\"diff diff-changed\">$line</td>");
           } elsif ($lb1 == $j) {
             my $html_line;
             while ($lb1 == $j) {
               my $begin_char = $l_culx - $b1;
   
               $line =~ /^(.*)(.{$begin_char})$/;
               $html_line .= spacedHtmlText($1) .
                 '</span><span class="diff diff-unchanged">';
               $line = $2;
               last if ($j != $le1);
   
               my $end_char = $l_culx - $e1;
               $line =~ /^(.*)(.{$end_char})$/;
               $html_line .= spacedHtmlText($1) .
                 '</span><span class="diff diff-changed">';
               $line = $2;
   
               $idx++;
               my ($tb1, $te1, $tlb1, $tle1, $tb2, $te2, $tlb2, $tle2) =
                 ($b1, $e1, $lb1, $le1, $b2, $e2, $lb2, $le2);
               ($b1, $e1, $lb1, $le1, $b2, $e2, $lb2, $le2) =
                 @diff_str[$idx*8..($idx+1)*8-1];
               $lb1 = $INFINITY if ($lb1 < 0);
               $lb2 = $INFINITY if ($lb2 < 0);
               $le1 = $INFINITY if ($le1 < 0);
               $le2 = $INFINITY if ($le2 < 0);
               if ($te1 > $b1) {
                 ($b1, $lb1) = ($te1, $tle1);
               }
               if ($te2 > $b2) {
                 ($b2, $lb2) = ($te2, $tle2);
               }
             }
             push(@left_html,
                  sprintf('<td><span class="diff diff-changed">%s%s</span></td>',
                          $html_line, spacedHtmlText($line)));
           } elsif ($le1 == $j) {
             my $html_line;
             while ($le1 == $j) {
               my $end_char = $l_culx - $e1;
               $line =~ /^(.*)(.{$end_char})$/;
               $html_line .= spacedHtmlText($1) .
                 '</span><span class="diff diff-changed">';
               $line = $2;
   
               $idx++;
               my ($tb1, $te1, $tlb1, $tle1, $tb2, $te2, $tlb2, $tle2) =
                 ($b1, $e1, $lb1, $le1, $b2, $e2, $lb2, $le2);
               ($b1, $e1, $lb1, $le1, $b2, $e2, $lb2, $le2) =
                 @diff_str[$idx*8..($idx+1)*8-1];
               $lb1 = $INFINITY if ($lb1 < 0);
               $lb2 = $INFINITY if ($lb2 < 0);
               $le1 = $INFINITY if ($le1 < 0);
               $le2 = $INFINITY if ($le2 < 0);
               if ($te1 > $b1) {
                 ($b1, $lb1) = ($te1, $tle1);
               }
               if ($te2 > $b2) {
                 ($b2, $lb2) = ($te2, $tle2);
               }
   
               last if ($lb1 != $j);
   
               my $begin_char = $l_culx - $b1;
   
               $line =~ /^(.*)(.{$begin_char})$/;
               $html_line .= spacedHtmlText($1) .
                 '</span><span class="diff diff-unchanged">';
               $line = $2;
             }
             push(@left_html,
                 sprintf('<td><span class="diff diff-unchanged">%s%s</span></td>',
                         $html_line, spacedHtmlText($line)));
           } else {
             $line = spacedHtmlText($line);
             push(@left_html, "<td class=\"diff diff-unchanged\">$line</td>");
           }
         }
         ($idx, $b1, $e1, $lb1, $le1, $b2, $e2, $lb2, $le2) =
           (0, @diff_str[0..7]);
         $lb1 = $INFINITY if ($lb1 < 0);
         $lb2 = $INFINITY if ($lb2 < 0);
         $le1 = $INFINITY if ($le1 < 0);
         $le2 = $INFINITY if ($le2 < 0);
         for (my $j = 0; $j < $rightRow; $j++) {
           my $line_len = length(@$rightColRef[$j]);
           my $line = @$rightColRef[$j];
           $r_cul += length($line) + 1; # includes "\n"
           my $r_culx = $r_cul - 1; # not includes "\n"
           if ($j < $lb2) {
             $line = spacedHtmlText($line);
             push(@right_html, "<td class=\"diff diff-changed\">$line</td>");
           } elsif ($lb2 == $j) {
             my $html_line;
             while ($lb2 == $j) {
               my $begin_char = $r_culx - $b2;
   
               $line =~ /^(.*)(.{$begin_char})$/;
               $html_line .= spacedHtmlText($1) .
                 '</span><span class="diff diff-unchanged">';
               $line = $2;
   
               last if ($j != $le2);
   
               my $end_char = $r_culx - $e2;
               $line =~ /^(.*)(.{$end_char})$/;
               $html_line .= spacedHtmlText($1) .
                 '</span><span class="diff diff-changed">';
               $line = $2;
   
               $idx++;
               my ($tb1, $te1, $tlb1, $tle1, $tb2, $te2, $tlb2, $tle2) =
                 ($b1, $e1, $lb1, $le1, $b2, $e2, $lb2, $le2);
               ($b1, $e1, $lb1, $le1, $b2, $e2, $lb2, $le2) =
                 @diff_str[$idx*8..($idx+1)*8-1];
               $lb1 = $INFINITY if ($lb1 < 0);
               $lb2 = $INFINITY if ($lb2 < 0);
               $le1 = $INFINITY if ($le1 < 0);
               $le2 = $INFINITY if ($le2 < 0);
               if ($te1 > $b1) {
                 ($b1, $lb1) = ($te1, $tle1);
               }
               if ($te2 > $b2) {
                 ($b2, $lb2) = ($te2, $tle2);
               }
             }
             push(@right_html,
                  sprintf('<td><span class="diff diff-changed">%s%s</span></td>',
                          $html_line, spacedHtmlText($line)));
           } elsif ($le2 == $j) {
             my $html_line;
             while ($le2 == $j) {
               my $end_char = $r_culx - $e2;
               $line =~ /^(.*)(.{$end_char})$/;
               $html_line .= spacedHtmlText($1) .
                 '</span><span class="diff diff-changed">';
               $line = $2;
   
               $idx++;
               my ($tb1, $te1, $tlb1, $tle1, $tb2, $te2, $tlb2, $tle2) =
                 ($b1, $e1, $lb1, $le1, $b2, $e2, $lb2, $le2);
               ($b1, $e1, $lb1, $le1, $b2, $e2, $lb2, $le2) =
                 @diff_str[$idx*8..($idx+1)*8-1];
               $lb1 = $INFINITY if ($lb1 < 0);
               $lb2 = $INFINITY if ($lb2 < 0);
               $le1 = $INFINITY if ($le1 < 0);
               $le2 = $INFINITY if ($le2 < 0);
               if ($te1 > $b1) {
                 ($b1, $lb1) = ($te1, $tle1);
               }
               if ($te2 > $b2) {
                 ($b2, $lb2) = ($te2, $tle2);
               }
   
               last if ($lb2 != $j);
   
               my $begin_char = $r_culx - $b2;
               $line =~ /^(.*)(.{$begin_char})$/;
               $html_line .= spacedHtmlText($1) .
                 '</span><span class="diff diff-unchanged">';
               $line = $2;
             }
             push(@right_html,
                  sprintf('<td nowrap="nowrap"><span class="diff diff-unchanged"'.
                          '>%s%s</span></td>',
                          $html_line, spacedHtmlText($line)));
           } else {
             $line = spacedHtmlText ($line);
             push @right_html, "<td class=\"diff diff-unchanged\">$line</td>";
           }
         }
         for (my $j = 0; $j < $leftRow || $j < $rightRow ; $j++) { # dump out both cols
           print  '<tr>';
           if ($j < $leftRow) {
             print $left_html[$j];
           } else {
             print '<td class="diff diff-changed-missing">&nbsp;</td>';
           }
           if ($j < $rightRow) {
             print $right_html[$j];
           } else {
             print '<td class="diff diff-changed-missing">&nbsp;</td>';
           }
           print "</tr>\n";
         }
       } else {
         for (my $j = 0; $j < $leftRow || $j < $rightRow; $j++) { # dump both cols
           print "<tr>\n";
           if ($j < $leftRow) {
             print '<td class="diff diff-changed">&nbsp;' .
               spacedHtmlText(@$leftColRef[$j]) . '</td>';
           } else {
             print '<td class="diff diff-changed-missing">&nbsp;</td>';
           }
           print "\n";
   
           if ($j < $rightRow) {
             print '<td class="diff diff-changed">&nbsp;' .
               spacedHtmlText(@$rightColRef[$j]) . '</td>';
           } else {
             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);  
 ##  
 sub human_readable_diff($) {  
         my ($difftxt, $where_nd, $filename, $pathname, $scriptwhere_nd);  
         my ($fh, $rev) = @_;  
         my ($date1, $date2, $r1d, $r2d, $r1r, $r2r, $rev1, $rev2, $sym1, $sym2);  
         my (@rightCol, @leftCol);  
   
         ($where_nd       = $where)       =~ s/.diff$//;  #
         ($filename       = $where_nd)    =~ s/^.*\///;  # Generates "human readable", HTMLified diffs.
         ($pathname       = $where_nd)    =~ s/(Attic\/)?[^\/]*$//;  #
         ($scriptwhere_nd = $scriptwhere) =~ s/.diff$//;  sub human_readable_diff($$)
   {
     my ($fh, $rev) = @_;
   
         navigateHeader($scriptwhere_nd, $pathname, $filename, $rev, "diff");    (my $where_nd       = $where)       =~ s|\.diff$||;
     (my $filename       = $where_nd)    =~ s|^.*/||;
     (my $pathname       = $where_nd)    =~ s|((?<=/)Attic/)?[^/]*$||;
     (my $scriptwhere_nd = $scriptwhere) =~ s|\.diff$||;
   
         # Read header to pick up read revision and date, if possible    navigateHeader($scriptwhere_nd, $pathname, $filename, $rev, 'diff');
         while (<$fh>) {  
                 ($r1d, $r1r) = /\t(.*)\t(.*)$/ if (/^--- /);  
                 ($r2d, $r2r) = /\t(.*)\t(.*)$/ if (/^\+\+\+ /);  
                 last if (/^\+\+\+ /);  
         }  
   
         if (defined($r1r) && $r1r =~ /^(\d+\.)+\d+$/) {    # Read header to pick up read revision and date, if possible.
                 $rev1  = $r1r;  
                 $date1 = $r1d;  
         }  
         if (defined($r2r) && $r2r =~ /^(\d+\.)+\d+$/) {  
                 $rev2  = $r2r;  
                 $date2 = $r2d;  
         }  
   
         print    my ($r1d, $r1r, $r2d, $r2r);
             "<h3 style=\"text-align: center\">Diff for /$where_nd between version $rev1 and $rev2</h3>\n",    while (<$fh>) {
             # Using style=\"border: none\" here breaks NS 4.x badly...      ($r1d, $r1r) = /\t(.*)\t(.*)$/ if (/^--- /);
             "<table border=\"0\" cellspacing=\"0\" cellpadding=\"0\" width=\"100%\">\n",      ($r2d, $r2r) = /\t(.*)\t(.*)$/ if (/^\+\+\+ /);
             "<tr style=\"background-color: #ffffff\">\n", "<th width=\"50%\" valign=\"top\">",      last if (/^\+\+\+ /);
             "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 $leftRow  = 0;    my ($rev1, $date1);
         my $rightRow = 0;    if (defined($r1r) && $r1r =~ /^(\d+\.)+\d+$/) {
         my ($oldline, $newline, $funname, $diffcode, $rest);      $rev1  = $r1r;
       $date1 = $r1d;
     }
     my ($rev2, $date2);
     if (defined($r2r) && $r2r =~ /^(\d+\.)+\d+$/) {
       $rev2  = $r2r;
       $date2 = $r2d;
     }
     $rev1  = $input{r1}      unless defined($rev1);
     $rev1  = $input{tr1}     if (defined($rev1) && $rev1 eq 'text');
     $rev1  = 'unknown-left'  unless defined($rev1);
     $rev2  = $input{r2}      unless defined($rev2);
     $rev2  = $input{tr2}     if (defined($rev2) && $rev2 eq 'text');
     $rev2  = 'unknown-right' unless defined($rev2);
     $date1 = defined($date1) ? ', ' . htmlquote($date1) : '';
     $date2 = defined($date2) ? ', ' . htmlquote($date2) : '';
   
         # Process diff text    my $link = uri_escape($filename) . ($query ? "$query;" : '?');
   
         # prefetch several lines    # Using <table style=\"border: none\" here breaks NS 4.x badly...
         my @buf = head($fh);    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 %d = scan_directives(@buf);    # Process diff text
     # prefetch several lines
     my @buf = head($fh);
     my %d = scan_directives(@buf);
   
         while (@buf || !eof($fh)) {    my $leftRow  = 0;
                 $difftxt = @buf ? shift @buf : <$fh>;    my $rightRow = 0;
     my ($difftxt, @rightCol, @leftCol, $oldline, $newline, $funname);
   
                 if ($difftxt =~ /^@@/) {    $link .= 'content-type=text%2Fx-cvsweb-markup;';
                         ($oldline, $newline, $funname) =    $link .= 'ln=1;' unless ($link =~ /\?.*\bln=1\b/);
                             $difftxt =~ /@@ \-([0-9]+).*\+([0-9]+).*@@(.*)/;  
                         $funname = htmlquote($funname);  
                         $funname =~ s/\s/&nbsp;/go;  
                         print  
                             "<tr class=\"diff-heading\">\n<td width=\"50%\">";  
                         print  
                             "<table width=\"100%\" border=\"1\" cellpadding=\"5\">\n<tr>\n<td><b>Line&nbsp;$oldline</b>";  
                         print  
                             "&nbsp;<span style=\"font-size: smaller\">$funname</span></td>\n</tr>\n</table>";  
                         print "</td>\n<td width=\"50%\">";  
                         print  
                             "<table width=\"100%\" border=\"1\" cellpadding=\"5\">\n<tr>\n<td><b>Line&nbsp;$newline</b>";  
                         print  
                             "&nbsp;<span style=\"font-size: smaller\">$funname</span></td>\n</tr>\n</table>\n";  
                         print "</td>\n";  
                         $state    = "dump";  
                         $leftRow  = 0;  
                         $rightRow = 0;  
                 } else {  
                         ($diffcode, $rest) = $difftxt =~ /^([-+ ])(.*)/;  
                         $_ = spacedHtmlText($rest, $d{'tabstop'});  
   
                         #########    while (@buf || !eof($fh)) {
                         # little state machine to parse unified-diff output (Hen, zeller@think.de)      $difftxt = @buf ? shift @buf : <$fh>;
                         # in order to get some nice 'ediff'-mode output  
                         # states:  
                         #  "dump"             - just dump the value  
                         #  "PreChangeRemove"  - we began with '-' .. so this could be the start of a 'change' area or just remove  
                         #  "PreChange"        - okey, we got several '-' lines and moved to '+' lines -> this is a change block  
                         ##########  
   
                         if ($diffcode eq '+') {      if ($difftxt =~ /^@@/) {
                                 if ($state eq "dump")        ($oldline, $newline, $funname) =
                                 { # 'change' never begins with '+': just dump out value          $difftxt =~ /@@ \-([0-9]+).*\+([0-9]+).*@@(.*)/;
                                         print        $funname = htmlquote($funname);
                                             "<tr>\n<td class=\"diff-empty\">&nbsp;</td>\n<td class=\"diff-added\">&nbsp;$_</td>\n</tr>\n";        $funname =~ s/\s/&nbsp;/go;
                                 } else {    # we got minus before        $funname &&= "&nbsp;<span style=\"font-size: smaller\">$funname</span>";
                                         $state = "PreChange";        my $ol = $oldline || 1;
                                         $rightCol[$rightRow++] = $_;        my $nl = $newline || 1;
                                 }  
                         } elsif ($diffcode eq '-') {  
                                 $state = "PreChangeRemove";  
                                 $leftCol[$leftRow++] = $_;  
                         } else {    # empty diffcode  
                                 flush_diff_rows \@leftCol, \@rightCol, $leftRow,  
                                     $rightRow;  
                                 print "<tr>\n<td class=\"diff-same\">&nbsp;$_</td>\n<td class=\"diff-same\">&nbsp;$_</td>\n</tr>\n";  
                                 $state    = "dump";  
                                 $leftRow  = 0;  
                                 $rightRow = 0;  
                         }  
                 }  
         }  
         close($fh);  
   
         flush_diff_rows \@leftCol, \@rightCol, $leftRow, $rightRow;        print <<EOF;
   <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 is empty if we didn't have any change        $state    = "dump";
         if (!$state) {        $leftRow  = 0;
                 print "<tr>\n<td colspan=\"2\">&nbsp;</td>\n</tr>\n";        $rightRow = 0;
                 print "<tr class=\"diff-empty\">\n";      } else {
                 print        my ($diffcode, $rest) = $difftxt =~ /^([-+ ])(.*)/;
                     "<td colspan=\"2\" align=\"center\"><b>- No viewable change -</b></td>\n</tr>\n";        $diffcode = '' unless defined($diffcode);
         }        $_ = $rest;
         print "</table>\n";  
   
         print "<hr style=\"width: 100%\" noshade>\n";        #########
         print "<form method=\"get\" action=\"${scriptwhere}\">\n";        # little state machine to parse unified-diff output (Hen, zeller@think.de)
         print "<table style=\"border: none\">\n<tr>\n<td>\n";        # in order to get some nice 'ediff'-mode output
         # states:
         #  "dump"             - just dump the value
         #  "PreChangeRemove"  - we began with '-' .. so this could be the start of a 'change' area or just remove
         #  "PreChange"        - okey, we got several '-' lines and moved to '+' lines -> this is a change block
         ##########
   
         # print legend        if ($diffcode eq '+') {
         print "<table border=\"1\">\n<tr>\n<td>";          if ($state eq "dump")
         print "Legend:<br><table style=\"border: none\" cellspacing=\"0\" cellpadding=\"1\">\n";          {    # 'change' never begins with '+': just dump out value
         print            $_ = spacedHtmlText($rest, $d{tabstop});
             "<tr>\n<td align=\"center\" class=\"diff-removed\">Removed from v.$rev1</td>\n<td class=\"diff-empty\">&nbsp;</td>\n</tr>\n";            printf(<<EOF, $_);
         print  <tr>
             "<tr class=\"diff-changed\">\n<td align=\"center\" colspan=\"2\">changed lines</td>\n</tr>\n";   <td class="diff diff-empty">&nbsp;</td>
         print   <td class="diff diff-added">&nbsp;%s</td>
             "<tr>\n<td class=\"diff-empty\">&nbsp;</td>\n<td align=\"center\" class=\"diff-added\">Added in v.$rev2</td>\n</tr>\n";  </tr>
         print "</table>\n</td>\n</tr>\n</table>\n</td>\n<td>";  EOF
           } else {    # we got minus before
             $state = "PreChange";
             $rightCol[$rightRow++] = $_;
           }
         } elsif ($diffcode eq '-') {
           $state = "PreChangeRemove";
           $leftCol[$leftRow++] = $_;
         } else {    # empty diffcode
           flush_diff_rows \@leftCol, \@rightCol, $leftRow, $rightRow;
           $_ = spacedHtmlText($rest, $d{tabstop});
           printf(<<EOF, $_, $_);
   <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);
   
         # Print format selector    flush_diff_rows \@leftCol, \@rightCol, $leftRow, $rightRow;
         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 "</td>\n";  
   
         print "</tr>\n</table>\n";    # state is empty if we didn't have any change
         print "</form>\n";    if (!$state) {
       print <<EOF;
   <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
     }
   
     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($use_java_script);
     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
 }  }
   
 sub navigateHeader($$$$$) {  
         my ($swhere, $path, $filename, $rev, $title) = @_;  
         $swhere = "" if ($swhere eq $scriptwhere);  
         $swhere = './' . urlencode($filename) if ($swhere eq "");  
   
         # TODO: this should be moved into external CSS file.  sub doEnscript($$$;$)
         my $css = '';  {
         if ($title eq 'diff') {    my ($filehandle, $highlight, $linenumbers, $lang) = @_;
             $css = "    $lang ||= 'cvsweb';
 <style type=\"text/css\">  
 .diff-heading {    my @cmd = ($CMD{enscript},
   background-color: $diffcolorHeading;               @enscript_options,
                '-q', "--language=$lang", '-o', '-', "--highlight=$highlight");
   
     local *ENSCRIPT_OUT;
     my ($h, $err) =
       startproc(\@cmd, $filehandle, '>pipe', \*ENSCRIPT_OUT);
     fatal('500 Internal Error', $err) unless $h;
   
     # We could short-circuit and have enscript output directly to STDOUT above,
     # but that doesn't work with mod_perl (at least some 1.99 versions).
     if ($linenumbers) {
       my $ln = 0;
       while (<ENSCRIPT_OUT>) {
         printf '<a id="l%d" class="src">%5d: </a>', (++$ln) x 2;
         print $_;
       }
     } else {
       local $/ = undef;
       print <ENSCRIPT_OUT>;
     }
     $h->finish();
 }  }
 .diff-same {  
   font-family: $difffontface;  
   font-size: smaller;  
 }  
 .diff-empty {  
   background-color: $diffcolorEmpty;  
 }  
 .diff-added {  
   background-color: $diffcolorAdd;  
   font-family: $difffontface;  
   font-size: smaller;  
 }  
 .diff-removed {  
   background-color: $diffcolorRemove;  
   font-family: $difffontface;  
   font-size: smaller;  
 }  
 .diff-changed {  
   background-color: $diffcolorChange;  
   font-family: $difffontface;  
   font-size: smaller;  
 }  
 .diff-changed-missing {  
   background-color: $diffcolorDarkChange;  
 }  
 </style>";  
         }  
   
         print <<EOF;  
   #
   # The passed in $path and $filename should not be URI escaped, and $swhere
   # *should* be.
   #
   sub navigateHeader($$$$$;$)
   {
     my ($swhere, $path, $filename, $rev, $title, $moddate) = @_;
     $swhere = "" if ($swhere eq $scriptwhere);
     $swhere = './' . uri_escape($filename) if ($swhere eq "");
   
     my $qfile = htmlquote($filename);
     my $qpath = htmlquote($path);
     my $trev  = $rev ? " - " . htmlquote($rev) : '';
   
     http_header('', $moddate);
   
     print <<EOF;
 $HTML_DOCTYPE  $HTML_DOCTYPE
 <html>  <html>
 <head>  <head>
 <title>$path$filename - $title - $rev</title>$css  <title>$qpath$qfile - $title$trev</title>
 $HTML_META</head>  $HTML_META$CSS</head>
 $body_tag_for_src  <body class="src">
 <table width="100%" style="border: none; background-color: $navigationHeaderColor" cellspacing="0" cellpadding="1">  <table class="navigate-header" width="100%" summary="Navigation">
 <tr valign="bottom"><td>   <tr>
     <td>
 EOF  EOF
   
         print &link($backicon, "$swhere$query#rev$rev");    my $frag = '';
         print "<b>Return to ", &link($filename, "$swhere$query#rev$rev"),    if ($rev) {
             " CVS log";      $frag  = '#';
         print "</b> $fileicon</td>";      $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 ",    print &link($backicon, $backurl);
           &clickablePath($path, 1),    printf '<b>Return to %s CVS log', &link($qfile, $backurl);
             "</b></td>";    print "</b> $fileicon</td>";
         print "</tr></table>";  
     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) = @_;  
         if ($num != 1) {  
                 $text .= "s";  
         }  
   
         if ($num > 0) {  sub plural_write($$)
                 return join (' ', $num, $text);  {
         } else {    my ($num, $text) = @_;
                 return "";    if ($num != 1) {
         }      $text .= "s";
     }
   
     if ($num > 0) {
       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 = (    my %desc = (
                 1,        'second', 60,     'minute', 3600,    'hour',                1        => 'second',
                 86400,    'day',    604800, 'week',   2628000, 'month',                60       => 'minute',
                 31536000, 'year'                3600     => 'hour',
         );                86400    => 'day',
         my @breaks = sort { $a <=> $b } keys %desc;                604800   => 'week',
         $i = 0;                2628000  => 'month',
                 31536000 => 'year'
                );
   
         while ($i <= $#breaks && $secs >= 2 * $breaks[$i]) {    my @breaks = sort { $a <=> $b } keys %desc;
                 $i++;    my $i = 0;
         }  
         $i--;  
         $break  = $breaks[$i];  
         $retval = plural_write(int($secs / $break), $desc{$break});  
   
         if ($long == 1 && $i > 0) {    while ($i <= $#breaks && $secs >= 2 * $breaks[$i]) {
                 my $rest = $secs % $break;      $i++;
                 $i--;    }
                 $break = $breaks[$i];    $i--;
                 my $resttime = plural_write(int($rest / $break), $desc{$break});    my $break  = $breaks[$i];
                 if ($resttime) {    my $retval = plural_write(int($secs / $break), $desc{$break});
                         $retval .= ", $resttime";  
                 }  
         }  
   
         return $retval;    if ($long == 1 && $i > 0) {
       my $rest = $secs % $break;
       $i--;
       $break = $breaks[$i];
       my $resttime = plural_write(int($rest / $break), $desc{$break});
       if ($resttime) {
         $retval .= ", $resttime";
       }
     }
   
     return $retval;
 }  }
   
 ##  
 # clickablePath(String pathname, boolean last_item_clickable)  
 #  #
 # returns a html-ified path whereas each directory is a link for  # 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    # This should never happen (see chooseCVSRoot()), but let's be sure...
                 # intended to do this    return $root if ($pathname eq '/');
                 $retval = "[$cvstree]";  
         } else {  
                 $retval .= ' ' . &link("[$cvstree]",  
                         sprintf('%s/%s#dirlist', $scriptname, $query));  
                 my $wherepath = '';  
                 my ($lastslash) = $pathname =~ m|/$|;  
   
                 foreach (split (/\//, $pathname)) {    my $retval =
                         $retval .= " / ";      ' ' . &link($root, sprintf('%s/%s#dirlist', $scriptname, $query));
                         $wherepath .= "/$_";    my $wherepath = '';
                         my ($last) = "$wherepath/" eq "/$pathname"    my ($lastslash) = $pathname =~ m|/$|;
                             || $wherepath eq "/$pathname";  
   
                         if ($clickLast || !$last) {    foreach (split(m|/|, $pathname)) {
                                 $retval .= &link($_,      $retval .= ' / ';
                                         join ('', $scriptname,      $wherepath .= "/$_";
                                         urlencode($wherepath),      my $last = "$wherepath/" eq "/$pathname" || $wherepath eq "/$pathname";
                                         (!$last || $lastslash ? '/' : ''),  
                                         $query,      if ($clickLast || !$last) {
                                         (!$last || $lastslash ? "#dirlist" : "")        $retval .= &link(htmlquote($_),
                                 ));                         join ('',
                         } else {    # do not make a link to the current dir                               $scriptname, uri_escape_path($wherepath),
                                 $retval .= $_;                               (!$last || $lastslash ? '/' : ''), $query,
                         }                               (!$last || $lastslash ? "#dirlist" : "")));
                 }      } else {    # do not make a link to the current dir
         }        $retval .= htmlquote($_);
         return $retval;      }
     }
     return $retval;
 }  }
   
 sub chooseCVSRoot() {  
   
         print "<form method=\"get\" action=\"${scriptwhere}\">\n";  sub chooseCVSRoot()
         if (2 <= @CVSROOT) {  {
                 my ($k);    print "<form method=\"get\" action=\"$scriptwhere\">\n<p>\n";
                 foreach $k (keys %input) {    if (2 <= @CVSROOT) {
                         print "<input type=\"hidden\" name=\"$k\" value=\"$input{$k}\">\n"      foreach my $k (keys %input) {
                             if ($input{$k}) && ($k ne "cvsroot");        printf("<input type=\"hidden\" name=\"%s\" value=\"%s\" />\n",
                 }               htmlquote($k), htmlquote($input{$k}))
           if ($input{$k} && $k ne 'cvsroot');
       }
   
                 # Form-Elements look wierd in Netscape if the background      printf(<<EOF, $use_java_script ? ' onchange="this.form.submit()"' : '');
                 # isn't gray and the form elements are not placed  <label for="cvsroot" accesskey="C">CVS Root:
                 # within a table ...  <select id="cvsroot" name="cvsroot"%s>
                 print "<table style=\"border: none\">\n<tr>\n";  EOF
                 print "<td><label for=\"cvsroot\" accesskey=\"C\">CVS Root:</label></td>\n";  
                 print "<td>\n<select id=\"cvsroot\" name=\"cvsroot\"";  
                 print " onchange=\"this.form.submit()\"" if $use_java_script;  
                 print ">\n";  
   
                 foreach $k (@CVSROOT) {      foreach my $k (@CVSROOT) {
                         print "<option value=\"$k\"";        printf("<option value=\"%s\"%s>%s</option>\n",
                         print " selected" if ($k eq $cvstree);               htmlquote($k),
                         print ">",($CVSROOTdescr{$k} ? $CVSROOTdescr{$k} : $k),               ($k eq $cvstree) ? ' selected="selected"' : '',
                             "</option>\n";               htmlquote($CVSROOTdescr{$k} || $k));
                 }      }
                 print "</select>\n</td>\n<td>";      print '</select></label>';
         } else {    } else {
   
                 # no choice -- but we need the form to select module/path,      # no choice -- but we need the form to select module/path,
                 # at least for Netscape      # at least for Netscape
                 print "<p>\n";      printf "CVS Root: <b>[%s]</b>",
                 print "CVS Root: <b>[$cvstree]</b>";        htmlquote($CVSROOTdescr{$cvstree} || $cvstree);
         }    }
   
         print " <label for=\"mpath\" accesskey=\"M\">Module path or alias:";    print <<EOF;
         print "</label>\n";  <label for="mpath" accesskey="M">
         print "<input type=\"text\" id=\"mpath\" name=\"path\" value=\"\" size=\"15\">\n";  Module path or alias:
         print "<input type=\"submit\" value=\"Go\" accesskey=\"O\">";  <input type="text" id="mpath" name="path" value="" size="15" />
   </label>
         if (2 <= @CVSROOT) {  <input type="submit" value="Go" accesskey="O" />
                 print "</td>\n</tr>\n</table>";  </p>
         } else {  </form>
                 print "</p>";  EOF
         }  
         print "\n</form>";  
 }  }
   
 sub chooseMirror() {  
   
         # This code comes from the original BSD-cvsweb  sub chooseMirror()
         # and may not be useful for your site; If you don't  {
         # set %MIRRORS this won't show up, anyway.    # This code comes from the original BSD-cvsweb
         scalar(%MIRRORS) or return;    # and may not be useful for your site; If you don't
     # set %MIRRORS this won't show up, anyway.
     scalar(%MIRRORS) or return;
   
         # Should perhaps exclude the current site somehow...    # Should perhaps exclude the current site somehow...
         print "\n<p>\nThis CVSweb is mirrored in\n";    print "\n<p>\nThis CVSweb is mirrored in\n";
   
         my @tmp = map(&link(htmlquote($_), $MIRRORS{$_}),    my @tmp = map(&link(htmlquote($_), $MIRRORS{$_}), sort keys %MIRRORS);
                       sort keys %MIRRORS);    my $tmp = pop (@tmp);
         my $tmp = pop(@tmp);  
   
         if (scalar(@tmp)) {    if (scalar(@tmp)) {
             print join(', ', @tmp), ' and ';      print join (', ', @tmp), ' and ';
         }    }
   
         print "$tmp.\n</p>\n";    print "$tmp.\n</p>\n";
 }  }
   
 sub fileSortCmp() {  
         my ($comp) = 0;  
         my ($c, $d, $af, $bf);  
   
         ($af = $a) =~ s/,v$//;  sub fileSortCmp()
         ($bf = $b) =~ s/,v$//;  {
         my ($rev1, $date1, $log1, $author1, $filename1) = @{$fileinfo{$af}}    (my $af = $a) =~ s/,v$//;
             if (defined($fileinfo{$af}));    (my $bf = $b) =~ s/,v$//;
         my ($rev2, $date2, $log2, $author2, $filename2) = @{$fileinfo{$bf}}    my ($rev1, $date1, $log1, $author1, $filename1) = @{$fileinfo{$af}}
             if (defined($fileinfo{$bf}));      if (defined($fileinfo{$af}));
     my ($rev2, $date2, $log2, $author2, $filename2) = @{$fileinfo{$bf}}
       if (defined($fileinfo{$bf}));
   
         if (defined($filename1) && defined($filename2) && $af eq $filename1    my $comp = 0;
             && $bf eq $filename2)    if (defined($filename1) && defined($filename2) &&
         {        $af eq $filename1   && $bf eq $filename2)
     {
   
                 # Two files      # Two files
                 $comp = -revcmp($rev1, $rev2) if ($byrev && $rev1 && $rev2);      $comp = -revcmp($rev1, $rev2)             if ($byrev  && $rev1  && $rev2);
                 $comp = ($date2 <=> $date1) if ($bydate && $date1 && $date2);      $comp = ($date2   <=> $date1)             if ($bydate && $date1 && $date2);
                 $comp = ($log1 cmp $log2) if ($bylog && $log1 && $log2);      if ($input{ignorecase}) {
                 $comp = ($author1 cmp $author2)        $comp = (uc($log1)    cmp uc($log2))    if ($bylog && $log1 && $log2);
                     if ($byauthor && $author1 && $author2);        $comp = (uc($author1) cmp uc($author2)) if ($byauthor &&
         }                                                    $author1 && $author2);
       } else {
         $comp = ($log1    cmp $log2)            if ($bylog && $log1 && $log2);
         $comp = ($author1 cmp $author2)         if ($byauthor &&
                                                     $author1 && $author2);
       }
     }
   
         if ($comp == 0) {    if ($comp == 0) {
   
                 # Directories first, then files under version control,      # Directories first, then files under version control,
                 # then other, "rogue" files.      # then other, "rogue" files.
                 # Sort by filename if no other criteria available.      # Sort by filename if no other criteria available.
   
                 my $ad = ((-d "$fullname/$a") ? 'D'      my $ad = (
                     : (defined($fileinfo{$af}) ? 'F' : 'R'));        (-d "$fullname/$a")
                 my $bd = ((-d "$fullname/$b") ? 'D'        ? 'D'
                     : (defined($fileinfo{$bf}) ? 'F' : 'R'));        : (defined($fileinfo{$af}) ? 'F' : 'R')
                 ($c = $a) =~ s|.*/||;      );
                 ($d = $b) =~ s|.*/||;      my $bd = (
                 $comp = ("$ad$c" cmp "$bd$d");        (-d "$fullname/$b")
         }        ? 'D'
         return $comp;        : (defined($fileinfo{$bf}) ? 'F' : 'R')
 }      );
       (my $c = $a) =~ s|.*/||;
       (my $d = $b) =~ s|.*/||;
   
 # make A url for downloading      my ($l, $r) = ("$ad$c", "$bd$d");
 sub download_url($$;$) {      $comp = $input{ignorecase} ? (uc($l) cmp uc($r)) : ($l cmp $r);
         my ($url, $revision, $mimetype) = @_;  
   
         $revision =~ s/\b0\.//;      # Parent dir is always first, then Attic.
       if ($comp != 0) {
         if (defined($checkoutMagic)        if ($l eq 'D..') {
             && (!defined($mimetype) || $mimetype ne "text/x-cvsweb-markup"))          $comp = -1;
         {        } elsif ($r eq 'D..') {
                 my $path = $where;          $comp = 1;
                 $path =~ s|[^/]+$||;        } elsif ($l eq 'DAttic') {
                 $url = "$scriptname/$checkoutMagic/${path}$url";          $comp = -1;
         }        } elsif ($r eq 'DAttic') {
         $url .= "?rev=$revision";          $comp = 1;
         $url .= '&content-type=' . urlencode($mimetype) if (defined($mimetype));        }
       }
         $url;    }
     return $comp;
 }  }
   
 # Presents a link to download the  #
 # selected revision  # Returns a URL to download the selected revision.
 sub download_link($$$;$) {  # Expects the passed in URL to be URI escaped, relative, and without a query
         my ($url, $revision, $textlink, $mimetype) = @_;  # string.
         my ($fullurl) = download_url($url, $revision, $mimetype);  #
   sub download_url($$;$)
   {
     my ($url, $revision, $mimetype) = @_;
     my @dots = $revision =~ /\./g;
     $revision =~ s/\b0\.(?=\d+$)// if (scalar(@dots) & 1);
   
         $fullurl =~ s/:/sprintf("%%%02x", ord($&))/eg;    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;
   
         printf '<a href="%s"', hrefquote("$fullurl$barequery");    return $url;
   }
   
         if ($open_extern_window  #
             && (!defined($mimetype) || $mimetype ne "text/x-cvsweb-markup"))  # Returns a link to download the selected revision.
         {  # Expects the passed in URL to be URI escaped, relative,
                 print ' target="cvs_checkout"';  # 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));
   }
   
                 # we should have  #
                 #   'if (document.cvswin==null) document.cvswin=window.open(...'  # Returns a URL to display the selected revision.
                 # in order to allow the user to resize the window; otherwise  # Expects the passed in URL to be URI escaped, and without a query string.
                 # the user may resize the window, but on next checkout - zap -  #
                 # its original (configured s. cvsweb.conf) size is back again  sub display_url($$;$)
                 # .. annoying (if $extern_window_(width|height) is defined)  {
                 # but this if (..) solution is far from perfect    my ($url, $revision, $mimetype) = @_;
                 # what we need to do as well is    $url .= '?rev=' . uri_escape($revision);
                 # 1) save cvswin in an invisible frame that always exists    $url .= ';content-type=' . uri_escape($mimetype) if $mimetype;
                 #    (document.cvswin will be void on next load)    return $url;
                 # 2) on close of the cvs_checkout - window set the cvswin  }
                 #    variable to 'null' again - so that it will be  
                 #    reopenend with the configured size  
                 # anyone a JavaScript programmer ?  
                 # .. so here without if (..):  
                 # currently, the best way is to comment out the size parameters  
                 # ($extern_window...) in cvsweb.conf.  
                 if ($use_java_script) {  
                         my @attr = qw(resizable scrollbars);  
   
                         push @attr, qw(status toolbar)  #
                             if (defined($mimetype) && $mimetype eq "text/html");  # 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));
   }
   
                         push @attr, "width=$extern_window_width"  #
                             if (defined($extern_window_width));  # Expects the passed in URL to be URI escaped, and without a query string.
   # The passed in link text should be already HTML escaped as appropriate.
   #
   sub graph_link($;$)
   {
     my ($url, $text) = @_;
     $text ||= $graphicon;
     return sprintf('<a href="%s?graph=1%s">%s</a>', $url, $barequery, $text);
   }
   
                         push @attr, "height=$extern_window_height"  #
                             if (defined($extern_window_height));  # Returns a link to CVSHistory for the given directory and filename.
   #
                         # We need the "return false" here to prevent browsers  sub history_link($$;$)
                         # from following the href after the onclick handler.  {
                         # This would effectively load the same document in    my ($dir, $file, $text) = @_;
                         # the same window *twice*.    $dir  ||= '';
                         printf    $file ||= '';
                             q` onclick="window.open('%s','cvs_checkout','%s');return false"`,    $text ||= 'History';
                             hrefquote("$fullurl$barequery"), join (',', @attr);    return &link($text,
                 }                 sprintf('%s?cvsroot=%s;dsearch=%s;fsearch=%s;limit=1',
         }                         $cvshistory_url, uri_escape($input{cvsroot} || ''),
         print "><b>$textlink</b></a>";                         uri_escape($dir), uri_escape($file)));
 }  }
   
 # Returns a Query string with the  # Returns a Query string with the
 # specified parameter toggled  # specified parameter toggled
 sub toggleQuery($$) {  sub toggleQuery($;$)
         my ($toggle, $value) = @_;  {
         my ($newquery, $var);    my ($toggle, $value) = @_;
         my (%vars);  
         %vars = %input;  
   
         if (defined($value)) {    my %vars = %input;
                 $vars{$toggle} = $value;  
         } else {  
                 $vars{$toggle} = $vars{$toggle} ? 0 : 1;  
         }  
   
         # Build a new query of non-default paramenters    if (defined($value)) {
         $newquery = "";      $vars{$toggle} = $value;
         foreach $var (@stickyvars) {    } else {
                 my ($value) = defined($vars{$var}) ? $vars{$var} : "";      $vars{$toggle} = $vars{$toggle} ? 0 : 1;
                 my ($default) =    }
                     defined($DEFAULTVALUE{$var}) ? $DEFAULTVALUE{$var} : "";  
   
                 if ($value ne $default) {    # Build a new query of non-default paramenters
                         $newquery .= "&" if ($newquery ne "");    my $newquery = "";
                         $newquery .= urlencode($var) . "=" . urlencode($value);    foreach my $var (@stickyvars) {
                 }      my ($value)   = defined($vars{$var})         ? $vars{$var}         : "";
         }      my ($default) = defined($DEFAULTVALUE{$var}) ? $DEFAULTVALUE{$var} : "";
   
         if ($newquery) {      if ($value ne $default) {
                 return '?' . $newquery;        $newquery .= ';' if ($newquery ne "");
         }        $newquery .= uri_escape($var) . '=' . uri_escape($value);
         return "";      }
     }
   
     if ($newquery) {
       return '?' . $newquery;
     }
     return "";
 }  }
   
 sub urlencode($) {  sub htmlquote($)
         local ($_) = @_;  {
     local ($_) = @_;
         s/[\000-+{-\377]/sprintf("%%%02x", ord($&))/ge;    # Special Characters; RFC 1866
     s/&/&amp;/g;
         $_;    s/\"/&quot;/g;
     s/</&lt;/g;
     s/>/&gt;/g;
     return $_;
 }  }
   
 sub htmlquote($) {  sub htmlunquote($)
         local ($_) = @_;  {
     local ($_) = @_;
         # Special Characters; RFC 1866    # Special Characters; RFC 1866
         s/&/&amp;/g;    s/&quot;/\"/g;
         s/\"/&quot;/g;    s/&lt;/</g;
         s/</&lt;/g;    s/&gt;/>/g;
         s/>/&gt;/g;    s/&amp;/&/g;
     return $_;
         $_;  
 }  }
   
 sub htmlunquote($) {  sub uri_escape_path($)
         local ($_) = @_;  {
     return join('/', map(uri_escape($_), split(m|/+|, shift, -1)));
         # Special Characters; RFC 1866  
         s/&quot;/\"/g;  
         s/&lt;/</g;  
         s/&gt;/>/g;  
         s/&amp;/&/g;  
   
         $_;  
 }  }
   
 sub hrefquote($) {  sub http_header(;$$)
         local ($_) = @_;  {
     my ($content_type, $moddate) = @_;
     $content_type ||= 'text/html';
   
         y/ /+/;    $content_type .= "; charset=$charset"
       if ($charset && $content_type =~ m,^text/,);
   
         htmlquote($_)    # Note that in the following, we explicitly join() and concatenate the
 }    # headers instead of printing them as an array.  This is because some
     # systems, eg. early versions of mod_perl 2 don't quite get it if the
     # last \r\n\r\n isn't included in the last "payload" header print().
   
 sub http_header(;$) {    my @headers = ();
         my $content_type = shift || "text/html";    # TODO: ctime(3) from scalar gmtime() isn't HTTP compliant, see HTTP::Date.
     push(@headers, 'Last-Modified: ' . scalar gmtime($moddate) . ' GMT')
       if $moddate;
     push(@headers, 'Content-Type: ' . $content_type);
   
         $content_type .= "; charset=$charset"    if ($allow_compress && $maycompress) {
             if $content_type =~ m,^text/, && defined($charset) && $charset;      if (HAS_ZLIB
           || (defined($CMD{gzip}) && open(GZIP, "| $CMD{gzip} -1 -c")))
       {
   
         if (defined($moddate)) {        push(@headers, 'Content-Encoding: x-gzip');
                 if ($is_mod_perl) {        push(@headers, 'Vary: Accept-Encoding');     # RFC 2616, 14.44
                         Apache->request->header_out(        print join("\r\n", @headers) . "\r\n\r\n";
                                 "Last-Modified" => scalar gmtime($moddate)  
                                 . " GMT");  
                 } else {  
                         print "Last-Modified: ", scalar gmtime($moddate),  
                             " GMT\r\n";  
                 }  
         }  
   
         if ($is_mod_perl) {        $| = 1;
                 Apache->request->content_type($content_type);        $| = 0;                                      # Flush header output.
         } else {  
                 print "Content-Type: $content_type\r\n";  
         }  
   
         if ($allow_compress && $maycompress) {        tie(*GZIP, __PACKAGE__, \*STDOUT) if HAS_ZLIB;
                 if ($has_zlib        select(GZIP);
                     || (defined($CMD{gzip}) && open(GZIP, "| $CMD{gzip} -1 -c"))        $gzip_open = 1;
                     )  
                 {  
   
                         if ($is_mod_perl) {      } else {
                                 Apache->request->content_encoding("x-gzip");  
                                 Apache->request->header_out(  
                                         Vary => "Accept-Encoding");  
                                 Apache->request->send_http_header;  
                         } else {  
                                 print "Content-Encoding: x-gzip\r\n";  
                                 print "Vary: Accept-Encoding\r\n"  
                                     ;            #RFC 2068, 14.43  
                                 print "\r\n";    # Close headers  
                         }  
                         $| = 1;  
                         $| = 0;    # Flush header output  
   
                         if ($has_zlib) {        print join("\r\n", @headers) . "\r\n\r\n";
                                 tie *GZIP, __PACKAGE__, \*STDOUT;        printf
                         }          '<span style="font-size: smaller">Unable to find gzip binary in the <b>$command_path</b> (<code>%s</code>) to compress output</span><br />',
                         select(GZIP);            htmlquote(join(':', @command_path));
                         $gzip_open = 1;      }
   
                         #           print "<!-- gzipped -->" if ($content_type =~ m|^text/html\b|);    } else {
                 } else {      print join("\r\n", @headers) . "\r\n\r\n";
                         if ($is_mod_perl) {    }
                                 Apache->request->send_http_header;  
                         } else {  
                                 print "\r\n";    # Close headers  
                         }  
                         print  
                             "<span style=\"font-size: smaller\">Unable to find gzip binary in the <b>\$command_path</b> ($command_path) to compress output</span><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) = @_;
     $title  = htmlquote($title);
     my $l   = $logo || '';
     my $css = $CSS || '';
     http_header('text/html', $moddate);
     print <<EOH;
 $HTML_DOCTYPE  $HTML_DOCTYPE
 <html>  <html>
 <head>  <head>
 <title>$title</title>  <title>$title</title>
 $HTML_META</head>  $HTML_META$css</head>
 $body_tag  <body>
 $logo <h1 align="center">$title</h1>  $l <h1>$title</h1>
 EOH  EOH
 }  }
   
 sub html_footer() {  sub html_footer()
         print "<hr noshade>\n<address>$address</address>\n" if $address;  {
         print "</body>\n</html>\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 .=      $ret .= ",\n" if ($ret ne "");
                     &link($sym, $fileurl . toggleQuery('only_with_tag', $sym));      $ret .= &link(htmlquote($sym),
         }                    $fileurl . toggleQuery('only_with_tag', $sym));
         return "$ret\n";    }
     return $ret;
 }  }
   
   
 #  #
 # See if a module is listed in the config file's @HideModules 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) = @_;  {
         local $_;    (my $path = canonpath(shift)) =~ s/,v$//;
     $path =~ s|^$cvsroot/+||;
     for my $forbidden_re (@ForbiddenFiles) {
       return 1 if ($path =~ $forbidden_re);
     }
     return 0;
   }
   
         for (@HideModules) {  
                 return 1 if $module =~ $_;  #
         }  # Starts a process using IPC::Run.  All arguments are passed to
         return 0;  # 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);
 }  }
   
 sub forbidden_file($) {  #
         my ($path) = @_;  # Runs a process using IPC::Run.  All arguments are passed to
         $path =  substr($path, length($cvsroot) + 1);  # IPC::Run::run() as-is.  Returns an array ($exitcode, $errormsg).
         local $_;  #
         for (@ForbiddenFiles) {  sub runproc(@)
                 return 1 if $path =~ $_;  {
         }    eval {
         return 0;      local $SIG{__DIE__};
       IPC::Run::run(@_);
     };
     my $exitcode = $? >> 8;
     my $errormsg  = undef;
     if ($@) {
       $exitcode ||= -1;
       $errormsg = "'@{$_[0]}' failed: $@";
     }
     return ($exitcode, $errormsg);
 }  }
   
 # Close the GZIP handle remove the tie.  #
   # Check out a file to a temporary file.
   #
   sub checkout_to_temp($$$)
   {
     my ($cvsroot, $cvsname, $rev) = @_;
   
 sub gzipclose {    # Pipe given cvs file into a temporary place.
         if ($gzip_open) {    my ($temp_fh, $temp_fn) = tempfile('.cvsweb.XXXXXXXX', DIR => tmpdir());
                 select(STDOUT);  
                 close(GZIP);    my @cmd = ($CMD{cvs}, @cvs_options, '-Qd', $cvsroot,
                 untie *GZIP;               'co', '-p', "-r$rev", $cvsname);
                 $gzip_open = 0;  
         }    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.
   
Line 3698  sub MAGIC1() { 0x1f }
Line 4445  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(    my ($class, $out) = @_;
                 -Level      => Compress::Zlib::Z_BEST_COMPRESSION(),    my ($d) = Compress::Zlib::deflateInit(
                 -WindowBits => -Compress::Zlib::MAX_WBITS()      -Level      => Compress::Zlib::Z_BEST_COMPRESSION(),
         ) or return undef;      -WindowBits => -Compress::Zlib::MAX_WBITS()
         my ($o) = {      )
                 handle => $out,      or return undef;
                 dh     => $d,    my ($o) = { handle => $out,
                 crc    => 0,                dh     => $d,
                 len    => 0,                crc    => 0,
         };                len    => 0,
         my ($header) =              };
             pack("c10", MAGIC1, MAGIC2, Compress::Zlib::Z_DEFLATED(), 0, 0, 0,    my ($header) = pack("c10",
             0, 0, 0, OSCODE);                        MAGIC1, MAGIC2, Compress::Zlib::Z_DEFLATED(),
         print {$o->{handle}} $header;                        0, 0, 0, 0, 0, 0, OSCODE);
         return bless($o, $class);    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.36  
changed lines
  Added in v.1.1.1.37

CVSweb