[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.17 and 1.1.1.22

version 1.1.1.17, 2000/12/29 09:20:45 version 1.1.1.22, 2001/01/14 08:49:27
Line 1 
Line 1 
 #!/usr/bin/perl5 -ws  #!/usr/bin/perl -wT
 #  #
 # cvsweb - a CGI interface to CVS trees.  # cvsweb - a CGI interface to CVS trees.
 #  #
Line 18 
Line 18 
 # Copyright (c) 1996-1998 Bill Fenner  # Copyright (c) 1996-1998 Bill Fenner
 #           (c) 1998-1999 Henner Zeller  #           (c) 1998-1999 Henner Zeller
 #           (c) 1999      Henrik Nordstrom  #           (c) 1999      Henrik Nordstrom
 #           (c) 2000      Akinori MUSHA  #           (c) 2000-2001 Akinori MUSHA
 # 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 42 
Line 42 
 # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF  # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
 # SUCH DAMAGE.  # SUCH DAMAGE.
 #  #
 # $zId: cvsweb.cgi,v 1.104 2000/11/01 22:05:12 hnordstrom Exp $  # $zId: cvsweb.cgi,v 1.105 2000/11/26 01:51:04 jumager Exp $
 # $kId: cvsweb.cgi,v 1.49 2000/12/29 09:12:15 knu Exp $  # $Idaemons: /home/cvs/cvsweb/cvsweb.cgi,v 1.64 2001/01/13 07:48:09 knu Exp $
 #  #
 ###  ###
   
   require 5.000;
   
 use strict;  use strict;
   
 use vars qw (  use vars qw (
     $config $allow_version_select $verbose      $cvsweb_revision
     %CVSROOT %CVSROOTdescr %MIRRORS %DEFAULTVALUE %ICONS %MTYPES      $mydir $uname $config $allow_version_select $verbose
       @CVSrepositories @CVSROOT %CVSROOT %CVSROOTdescr
       %MIRRORS %DEFAULTVALUE %ICONS %MTYPES
     @DIFFTYPES %DIFFTYPES @LOGSORTKEYS %LOGSORTKEYS      @DIFFTYPES %DIFFTYPES @LOGSORTKEYS %LOGSORTKEYS
     %alltags @tabcolors %fileinfo %tags @branchnames %nameprinted      %alltags @tabcolors %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
     $prcgi @prcategories $prcategories $mancgi      $prcgi @prcategories $re_prcategories $prkeyword $re_prkeyword $mancgi
     $checkoutMagic $doCheckout $scriptname $scriptwhere      $checkoutMagic $doCheckout $scriptname $scriptwhere
     $where $pathinfo $Browser $nofilelinks $maycompress @stickyvars      $where $pathinfo $Browser $nofilelinks $maycompress @stickyvars
     %funcline_regexp $is_mod_perl      %funcline_regexp $is_mod_perl
Line 64  use vars qw (
Line 68  use vars qw (
     %input $query $barequery $sortby $bydate $byrev $byauthor      %input $query $barequery $sortby $bydate $byrev $byauthor
     $bylog $byfile $defaultDiffType $logsort $cvstree $cvsroot      $bylog $byfile $defaultDiffType $logsort $cvstree $cvsroot
     $mimetype $charset $defaultTextPlain $defaultViewable      $mimetype $charset $defaultTextPlain $defaultViewable
     $allow_compress $GZIPBIN $backicon $diricon $fileicon      $command_path %CMD $allow_compress
       $backicon $diricon $fileicon
     $fullname $newname $cvstreedefault      $fullname $newname $cvstreedefault
     $body_tag $body_tag_for_src $logo $defaulttitle $address      $body_tag $body_tag_for_src $logo $defaulttitle $address
     $long_intro $short_instruction $shortLogLen      $long_intro $short_instruction $shortLogLen
Line 75  use vars qw (
Line 80  use vars qw (
     $difffontsize $inputTextSize $mime_types $allow_annotate      $difffontsize $inputTextSize $mime_types $allow_annotate
     $allow_markup $use_java_script $open_extern_window      $allow_markup $use_java_script $open_extern_window
     $extern_window_width $extern_window_height $edit_option_form      $extern_window_width $extern_window_height $edit_option_form
     $show_subdir_lastmod $show_log_in_markup $v      $show_subdir_lastmod $show_log_in_markup $preformat_in_markup $v
     $navigationHeaderColor $tableBorderColor $markupLogColor      $navigationHeaderColor $tableBorderColor $markupLogColor
     $tabstop $state $annTable $sel $curbranch @HideModules      $tabstop $state $annTable $sel $curbranch @HideModules
     $module $use_descriptions %descriptions @mytz $dwhere $moddate      $module $use_descriptions %descriptions @mytz $dwhere $moddate
     $use_moddate $has_zlib $gzip_open $allow_tar      $use_moddate $has_zlib $gzip_open
       $allow_tar @tar_options @gzip_options @cvs_options
     $LOG_FILESEPARATOR $LOG_REVSEPARATOR      $LOG_FILESEPARATOR $LOG_REVSEPARATOR
 );  );
   
Line 95  sub revcmp($$);
Line 101  sub revcmp($$);
 sub fatal($$);  sub fatal($$);
 sub redirect($);  sub redirect($);
 sub safeglob($);  sub safeglob($);
   sub search_path($);
 sub getMimeTypeFromSuffix($);  sub getMimeTypeFromSuffix($);
 sub head($;$);  sub head($;$);
 sub scan_directives(@);  sub scan_directives(@);
Line 130  sub link_tags($);
Line 137  sub link_tags($);
 sub forbidden_module($);  sub forbidden_module($);
   
 ##### Start of Configuration Area ########  ##### Start of Configuration Area ########
 use Cwd;  delete $ENV{PATH};
   
   $cvsweb_revision = join('.', '1.105', (split(/ /,
    q$Idaemons: /home/cvs/cvsweb/cvsweb.cgi,v 1.64 2001/01/13 07:48:09 knu Exp $
   ))[2]);
   
   use File::Basename;
   
   ($mydir) = (dirname($0) =~ /(.*)/); # untaint
   
 # == EDIT this ==  # == EDIT this ==
 # Locations to search for user configuration, in order:  # Locations to search for user configuration, in order:
 for (  for (
      $ENV{CVSWEB_CONFIG},       "$mydir/cvsweb.conf",
      '/usr/local/etc/cvsweb.conf',       '/usr/local/etc/cvsweb/cvsweb.conf'
      getcwd() . '/cvsweb.conf'  
     ) {      ) {
     $config = $_ if defined($_) && -r $_;      if (defined($_) && -r $_) {
           $config = $_;
           last;
       }
 }  }
   
 # == Configuration defaults ==  # == Configuration defaults ==
Line 151  $allow_version_select = 1;
Line 168  $allow_version_select = 1;
   
 ######## Configuration variables #########  ######## Configuration variables #########
 # These are defined to allow checking with perl -cw  # These are defined to allow checking with perl -cw
 %CVSROOT = %MIRRORS = %DEFAULTVALUE = %ICONS = %MTYPES =  @CVSrepositories = @CVSROOT = %CVSROOT =
   %MIRRORS = %DEFAULTVALUE = %ICONS = %MTYPES =
 %tags = %alltags = @tabcolors = ();  %tags = %alltags = @tabcolors = ();
 $cvstreedefault = $body_tag = $body_tag_for_src =  $cvstreedefault = $body_tag = $body_tag_for_src =
 $logo = $defaulttitle = $address =  $logo = $defaulttitle = $address =
Line 229  $verbose = $v;
Line 247  $verbose = $v;
 $checkoutMagic = "~checkout~";  $checkoutMagic = "~checkout~";
 $pathinfo = defined($ENV{PATH_INFO}) ? $ENV{PATH_INFO} : '';  $pathinfo = defined($ENV{PATH_INFO}) ? $ENV{PATH_INFO} : '';
 $where = $pathinfo;  $where = $pathinfo;
 $where =~ tr|/|/|s;  $doCheckout = ($where =~ m|^/$checkoutMagic/|);
 $doCheckout = ($where =~ /^\/$checkoutMagic/);  $where =~ s|^/$checkoutMagic/|/|;
 $where =~ s|^/($checkoutMagic)?||;  $where =~ s|^/||;
 $where =~ s|/$||;  
 $scriptname = defined($ENV{SCRIPT_NAME}) ? $ENV{SCRIPT_NAME} : '';  $scriptname = defined($ENV{SCRIPT_NAME}) ? $ENV{SCRIPT_NAME} : '';
 $scriptname =~ s|^/?|/|;  $scriptname =~ s|^/*|/|;
 $scriptname =~ s|/+$||;  
 $scriptwhere = $scriptname;  # Let's workaround thttpd's stupidity..
 if ($where) {  if ($scriptname =~ m|/$|) {
     $scriptwhere .= '/' . urlencode($where);      $pathinfo .= '/';
       my $re = quotemeta $pathinfo;
       $scriptname =~ s/$re$//;
 }  }
   
   $scriptwhere = $scriptname;
   $scriptwhere .= '/' . urlencode($where);
   $where = '/' if ($where eq '');
   
 $is_mod_perl = defined($ENV{MOD_PERL});  $is_mod_perl = defined($ENV{MOD_PERL});
   
 # in lynx, it it very annoying to have two links  # in lynx, it it very annoying to have two links
Line 355  else {
Line 378  else {
 }  }
 undef @barequery;  undef @barequery;
   
   if (defined($input{path})) {
       redirect("$scriptname/$input{path}$query");
   }
   
 # get actual parameters  # get actual parameters
 $sortby = $input{"sortby"};  $sortby = $input{"sortby"};
 $bydate = 0;  $bydate = 0;
Line 382  $defaultDiffType = $input{'f'};
Line 409  $defaultDiffType = $input{'f'};
   
 $logsort = $input{'logsort'};  $logsort = $input{'logsort'};
   
   my @tmp = @CVSrepositories;
   my @pair;
   
   while (@pair = splice(@tmp, 0, 2)) {
       my($key, $val) = @pair;
       my($descr, $cvsroot) = @$val;
   
       next if !-d $cvsroot;
   
       $CVSROOTdescr{$key} = $descr;
       $CVSROOT{$key} = $cvsroot;
       push @CVSROOT, $key;
   }
   undef @tmp;
   undef @pair;
   
 ## Default CVS-Tree  ## Default CVS-Tree
 if (!defined($CVSROOT{$cvstreedefault})) {  if (!defined($CVSROOT{$cvstreedefault})) {
    &fatal("500 Internal Error",     &fatal("500 Internal Error",
Line 426  if (-f $config_cvstree) {
Line 468  if (-f $config_cvstree) {
 }  }
 undef $config_cvstree;  undef $config_cvstree;
   
 $prcategories = '(?:' . join('|', @prcategories) . ')';  $re_prcategories = '(?:' . join('|', @prcategories) . ')' if @prcategories;
   $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 = "$cvsroot/$where";
 $mimetype = &getMimeTypeFromSuffix ($fullname);  $mimetype = &getMimeTypeFromSuffix ($fullname);
 $defaultTextPlain = ($mimetype eq "text/plain");  $defaultTextPlain = ($mimetype eq "text/plain");
 $defaultViewable = $allow_markup && viewable($mimetype);  $defaultViewable = $allow_markup && viewable($mimetype);
   
 # search for GZIP if compression allowed  my $rewrite = 0;
 # We've to find out if the GZIP-binary exists .. otherwise  
 # ge get an Internal Server Error if we try to pipe the  if ($pathinfo =~ m|//|) {
 # output through the nonexistent gzip ..      $pathinfo =~ y|/|/|s;
 # any more elegant ways to prevent this are welcome!      $rewrite = 1;
 if ($allow_compress && $maycompress && !$has_zlib) {  
     foreach (split(/:/, $ENV{PATH})) {  
         if (-x "$_/gzip") {  
             $GZIPBIN = "$_/gzip";  
             last;  
         }  
     }  
 }  }
   
 if (-d $fullname) {  if (-d $fullname && $pathinfo !~ m|/$|) {
     #      $pathinfo .= '/';
     # ensure, that directories always end with (exactly) one '/'      $rewrite = 1;
     # to allow relative URL's. If they're not, make a redirect.  
     ##  
     if (!($pathinfo =~ m|/$|) || ($pathinfo =~ m |/{2,}$|)) {  
         redirect ($scriptwhere . '/' . $query);  
     }  
     else {  
         $where .= '/';  
         $scriptwhere .= '/';  
     }  
 }  }
   
   if (!-d $fullname && $pathinfo =~ m|/$|) {
       chop $pathinfo;
       $rewrite = 1;
   }
   
   if ($rewrite) {
       redirect($scriptname . urlencode($pathinfo) . $query);
   }
   
   undef $rewrite;
   
 if (!-d $cvsroot) {  if (!-d $cvsroot) {
     &fatal("500 Internal Error",'$CVSROOT not found!<P>The server on which the CVS tree lives is probably down.  Please try again in a few minutes.');      &fatal("500 Internal Error",'$CVSROOT not found!<P>The server on which the CVS tree lives is probably down.  Please try again in a few minutes.');
 }  }
Line 481  if ($module && &forbidden_module($module)) {
Line 519  if ($module && &forbidden_module($module)) {
 if ($input{tarball}) {  if ($input{tarball}) {
     &fatal("403 Forbidden", "Downloading tarballs is prohibited.")      &fatal("403 Forbidden", "Downloading tarballs is prohibited.")
       unless $allow_tar;        unless $allow_tar;
     $where =~ s,/[^/]*$,,;      my($module) = ($where =~ m,^/?(.*),);       # untaint
     $where =~ s,^/,,;      $module =~ s,/[^/]*$,,;
     my($basedir) = ($where =~ m,([^/]+)$,);      my($basedir) = ($module =~ m,([^/]+)$,);
   
     if ($basedir eq '' || $where eq '') {      if ($basedir eq '' || $module eq '') {
         &fatal("500 Internal Error", "You cannot download the top level directory.");          &fatal("500 Internal Error", "You cannot download the top level directory.");
     }      }
   
Line 496  if ($input{tarball}) {
Line 534  if ($input{tarball}) {
   
     my $fatal = '';      my $fatal = '';
   
     do {      while (1) {
         chdir $tmpdir          my $tag = (exists $input{only_with_tag} && length $input{only_with_tag})
           or $fatal = "500 Internal Error", "Unable to cd to temporary directory: $!"            ? $input{only_with_tag} : "HEAD";
             && last;  
   
         my @params = (exists $input{only_with_tag} && length $input{only_with_tag})          system $CMD{cvs}, @cvs_options, '-Qd', $cvsroot, 'export', '-r', $tag, '-d', "$tmpdir/$basedir", $module
           ? ("-r", $input{only_with_tag}) : ();            and $fatal = "500 Internal Error","cvs co failure: $!: $module"
   
         system "cvs", "-RlQd", $cvsroot, "co", @params, $where  
           and $fatal = "500 Internal Error","cvs co failure: $!: $where"  
             && last;              && last;
   
         chdir "$where/.."  
           or $fatal = "500 Internal Error","Cannot find expected directory in checkout"  
             && last;  
   
         $| = 1; # Essential to get the buffering right.          $| = 1; # Essential to get the buffering right.
   
         print "Content-type: application/x-gzip\r\n\r\n";          print "Content-type: application/x-gzip\r\n\r\n";
   
         system "tar", "--ignore-failed-read", "--exclude", "CVS", "-zcf", "-", $basedir          system "$CMD{tar} @tar_options -cf - -C $tmpdir $basedir | $CMD{gzip} @gzip_options -c"
           and $fatal = "500 Internal Error","tar zc failure: $!: $basedir"            and $fatal = "500 Internal Error","tar zc failure: $!: $basedir"
             && last;              && last;
   
         chdir $tmpdir          last;
           or $fatal = "500 Internal Error","Unable to cd to temporary directory: $!"      }
             && last;  
     } while (0);  
   
     system "rm", "-rf", $tmpdir if -d $tmpdir;      system $CMD{rm}, '-rf', $tmpdir if -d $tmpdir;
   
     &fatal($fatal) if $fatal;      &fatal($fatal) if $fatal;
   
Line 710  if (-d $fullname) {
Line 738  if (-d $fullname) {
   
             if ($_ eq '..' || -d "$fullname/$_") {              if ($_ eq '..' || -d "$fullname/$_") {
                 next if ($_ eq '..' && $where eq '/');                  next if ($_ eq '..' && $where eq '/');
                 my ($rev,$date,$log,$author,$filename) = @{$fileinfo{$_}}                  my ($rev,$date,$log,$author,$filename);
                   ($rev,$date,$log,$author,$filename) = @{$fileinfo{$_}}
                     if (defined($fileinfo{$_}));                      if (defined($fileinfo{$_}));
                 printf '<tr bgcolor="%s"><td>', $tabcolors[$dirrow % 2] if $dirtable;                  printf '<tr bgcolor="%s"><td>', $tabcolors[$dirrow % 2] if $dirtable;
                 if ($_ eq '..') {                  if ($_ eq '..') {
Line 870  if (-d $fullname) {
Line 899  if (-d $fullname) {
                        ">$tag\n";                         ">$tag\n";
             }              }
             print "</SELECT>\n";              print "</SELECT>\n";
               print " Module path or alias:\n";
               printf "<INPUT TYPE=TEXT NAME=\"path\" VALUE=\"%s\" SIZE=15>\n", htmlquote($where);
             print "<INPUT TYPE=SUBMIT VALUE=\"Go\">\n";              print "<INPUT TYPE=SUBMIT VALUE=\"Go\">\n";
             print "</FORM>\n";              print "</FORM>\n";
         }          }
Line 877  if (-d $fullname) {
Line 908  if (-d $fullname) {
         if ($allow_tar) {          if ($allow_tar) {
             my($basefile) = ($where =~ m,(?:.*/)?([^/]+),);              my($basefile) = ($where =~ m,(?:.*/)?([^/]+),);
   
             if ($basefile ne '') {              if (defined($basefile) && $basefile ne '') {
                 print "<HR NOSHADE>\n",                  print "<HR NOSHADE>\n",
                   "<DIV align=center>",                    "<DIV align=center>",
                     &link("Download this directory in tarball",                      &link("Download this directory in tarball",
Line 972  if (-d $fullname) {
Line 1003  if (-d $fullname) {
         # The file has been removed and is in the Attic.          # The file has been removed and is in the Attic.
         # Send a redirect pointing to the file in the Attic.          # Send a redirect pointing to the file in the Attic.
         (my $newplace = $scriptwhere) =~ s|/([^/]+)$|/Attic/$1|;          (my $newplace = $scriptwhere) =~ s|/([^/]+)$|/Attic/$1|;
         &redirect($newplace);          redirect("$newplace$query");
         exit;          exit;
     }      }
     elsif (0 && (my @files = &safeglob($fullname . ",v"))) {      elsif (0 && (my @files = &safeglob($fullname . ",v"))) {
Line 988  if (-d $fullname) {
Line 1019  if (-d $fullname) {
         # Assume it's a module name with a potential path following it.          # Assume it's a module name with a potential path following it.
         $xtra = (($module = $where) =~ s|/.*||) ? $& : '';          $xtra = (($module = $where) =~ s|/.*||) ? $& : '';
         # Is there an indexed version of modules?          # Is there an indexed version of modules?
         if (open($fh, "$cvsroot/CVSROOT/modules")) {          if (open($fh, "< $cvsroot/CVSROOT/modules")) {
             while (<$fh>) {              while (<$fh>) {
                 if (/^(\S+)\s+(\S+)/o && $module eq $1                  if (/^(\S+)\s+(\S+)/o && $module eq $1
                     && -d "$cvsroot/$2" && $module ne $2) {                      && -d "$cvsroot/$2" && $module ne $2) {
                     &redirect("$scriptname/$2$xtra");                      redirect("$scriptname/$2$xtra$query");
                 }                  }
             }              }
         }          }
Line 1113  sub htmlify($;$) {
Line 1144  sub htmlify($;$) {
   
     if ($extra) {      if ($extra) {
         # get PR #'s as link: "PR#nnnn" "PR: nnnn, ..." "PR nnnn, ..." "bin/nnnn"          # get PR #'s as link: "PR#nnnn" "PR: nnnn, ..." "PR nnnn, ..." "bin/nnnn"
         if (defined($prcgi)) {          if (defined($prcgi) && defined($re_prcategories) && defined($re_prkeyword)) {
             my $prev;              my $prev;
   
             do {              do {
Line 1121  sub htmlify($;$) {
Line 1152  sub htmlify($;$) {
   
                 $_ = htmlify_sub {                  $_ = htmlify_sub {
                     s{                      s{
                       (\bPR[:\#]?\s*                        (\b$re_prkeyword[:\#]?\s*
                        (?:                         (?:
                         \#?                          \#?
                         \d+[,\s]\s*                          \d+[,\s]\s*
Line 1136  sub htmlify($;$) {
Line 1167  sub htmlify($;$) {
   
             $_ = htmlify_sub {              $_ = htmlify_sub {
                 s{                  s{
                   (\b$prcategories/(\d+)\b)                    (\b$re_prcategories/(\d+)\b)
                  }{                   }{
                      &link($1, sprintf($prcgi, $2))                       &link($1, sprintf($prcgi, $2))
                  }egox;                   }egox;
Line 1147  sub htmlify($;$) {
Line 1178  sub htmlify($;$) {
         if (defined($mancgi)) {          if (defined($mancgi)) {
             $_ = htmlify_sub {              $_ = htmlify_sub {
                 s{                  s{
                   (\b([a-zA-Z][\w_.]+)                    (\b([a-zA-Z][\w.]+)
                    (?:                     (?:
                     \( ([0-9n]) \)\B                      \( ([0-9n]) \)\B
                     |                      |
Line 1155  sub htmlify($;$) {
Line 1186  sub htmlify($;$) {
                    )                     )
                   )                    )
                  }{                   }{
                      &link($1, sprintf($mancgi, $3 ne '' ? $3 : $4, $2))                       &link($1, sprintf($mancgi, defined($3) ? $3 : $4, $2))
                  }egx;                   }egx;
             } $_;              } $_;
         }          }
Line 1195  sub spacedHtmlText($;$) {
Line 1226  sub spacedHtmlText($;$) {
 }  }
   
 sub link($$) {  sub link($$) {
         my($name, $where) = @_;          my($name, $url) = @_;
   
         sprintf '<A HREF="%s">%s</A>', hrefquote($where), $name;          sprintf '<A HREF="%s">%s</A>', hrefquote($url), $name;
 }  }
   
 sub revcmp($$) {  sub revcmp($$) {
Line 1279  sub safeglob($) {
Line 1310  sub safeglob($) {
         @results;          @results;
 }  }
   
   sub search_path($) {
       my($command) = @_;
       my $d;
   
       for $d (split(/:/, $command_path)) {
           return "$d/$command" if -x "$d/$command";
       }
   
       $command;
   }
   
 sub getMimeTypeFromSuffix($) {  sub getMimeTypeFromSuffix($) {
     my ($fullname) = @_;      my ($fullname) = @_;
     my ($mimetype, $suffix);      my ($mimetype, $suffix);
Line 1352  sub doAnnotate($$) {
Line 1394  sub doAnnotate($$) {
     my $reader = do {local(*FH);};      my $reader = do {local(*FH);};
     my $writer = do {local(*FH);};      my $writer = do {local(*FH);};
   
     # make sure the revisions a wellformed, for security      # make sure the revisions are wellformed, for security
     # reasons ..      # reasons ..
     if ($rev =~ /[^\w.]/) {      if ($rev =~ /[^\w.]/) {
         &fatal("404 Not Found",          &fatal("404 Not Found",
Line 1371  sub doAnnotate($$) {
Line 1413  sub doAnnotate($$) {
     # the public domain.      # the public domain.
     # we could abandon the use of rlog, rcsdiff and co using      # we could abandon the use of rlog, rcsdiff and co using
     # the cvsserver in a similiar way one day (..after rewrite)      # the cvsserver in a similiar way one day (..after rewrite)
     $pid = open2($reader, $writer, "cvs -Rl server") || fatal ("500 Internal Error",      $pid = open2($reader, $writer, "cvs", @cvs_options, "server")
                                                                "Fatal Error - unable to open cvs for annotation");        || fatal ("500 Internal Error", "Fatal Error - unable to open cvs for annotation");
   
     # OK, first send the request to the server.  A simplified example is:      # OK, first send the request to the server.  A simplified example is:
     #     Root /home/kingdon/zwork/cvsroot      #     Root /home/kingdon/zwork/cvsroot
Line 1563  sub doCheckout($$) {
Line 1605  sub doCheckout($$) {
     #      #
     # Safely for a child process to read from.      # Safely for a child process to read from.
     if (! open($fh, "-|")) { # child      if (! open($fh, "-|")) { # child
       open(STDERR, ">&STDOUT"); # Redirect stderr to stdout          open(STDERR, ">&STDOUT"); # Redirect stderr to stdout
       exec("cvs", "-Rld", $cvsroot, "co", "-p", $revopt, $where);          exec($CMD{cvs}, @cvs_options, '-d', $cvsroot, 'co', '-p', $revopt, $where);
     }      }
   
     if (eof($fh)) {      if (eof($fh)) {
Line 1646  sub cvswebMarkup($$$) {
Line 1688  sub cvswebMarkup($$$) {
     elsif ($mimetype =~ m%^application/pdf%) {      elsif ($mimetype =~ m%^application/pdf%) {
         printf '<EMBED SRC="%s" WIDTH="100%"><BR>', hrefquote("$url$barequery");          printf '<EMBED SRC="%s" WIDTH="100%"><BR>', hrefquote("$url$barequery");
     }      }
     else {      elsif ($preformat_in_markup) {
         print "<PRE>";          print "<PRE>";
   
         # prefetch several lines          # prefetch several lines
Line 1661  sub cvswebMarkup($$$) {
Line 1703  sub cvswebMarkup($$$) {
         }          }
         print "</PRE>";          print "</PRE>";
     }      }
       else {
           print "<PLAINTEXT>\n", <$filehandle>;
       }
 }  }
   
 sub viewable($) {  sub viewable($) {
Line 1741  sub doDiff($$$$$$) {
Line 1786  sub doDiff($$$$$$) {
         }          }
         if (! open($fh, "-|")) { # child          if (! open($fh, "-|")) { # child
             open(STDERR, ">&STDOUT"); # Redirect stderr to stdout              open(STDERR, ">&STDOUT"); # Redirect stderr to stdout
             exec("rcsdiff",@difftype,"-r$rev1","-r$rev2",$fullname);              exec($CMD{rcsdiff}, @difftype, "-r$rev1", "-r$rev2", $fullname);
         }          }
         if ($human_readable) {          if ($human_readable) {
             http_header();              http_header();
Line 1822  sub getDirLogs($$@) {
Line 1867  sub getDirLogs($$@) {
         return;          return;
     }      }
   
     if ($tag) {      if (defined($tag)) {
         #can't use -r<tag> as - is allowed in tagnames, but misinterpreated by rlog..          #can't use -r<tag> as - is allowed in tagnames, but misinterpreated by rlog..
         if (! open($fh, "-|")) {          if (! open($fh, "-|")) {
                 open(STDERR, '>/dev/null'); # rlog may complain; ignore.              open(STDERR, '>/dev/null'); # rlog may complain; ignore.
                 exec('rlog', @files);              exec($CMD{rlog}, @files);
         }          }
     }      }
     else {      else {
         my $kidpid = open($fh, "-|");          if (! open($fh, "-|")) {
         if (! $kidpid) {              open(STDERR, '>/dev/null'); # rlog may complain; ignore.
                 open(STDERR, '>/dev/null'); # rlog may complain; ignore.              exec($CMD{rlog}, '-r', @files);
                 exec('rlog', '-r', @files);  
         }          }
     }      }
     $state = "start";      $state = "start";
     while (<$fh>) {      while (<$fh>) {
         if ($state eq "start") {          if ($state eq "start") {
             #Next file. Initialize file variables              #Next file. Initialize file variables
             $rev = undef;              $rev = '';
             $revwanted = undef;              $revwanted = '';
             $branch = undef;              $branch = '';
             $branchpoint = undef;              $branchpoint = '';
             $filename = undef;              $filename = '';
             $log = undef;              $log = '';
             $revision = undef;              $revision = '';
             $branch = undef;  
             %symrev = ();              %symrev = ();
             @filetags = ();              @filetags = ();
             #jump to head state              #jump to head state
Line 1866  again:
Line 1909  again:
                 $branch = $1                  $branch = $1
             } elsif (/^symbolic names:/) {              } elsif (/^symbolic names:/) {
                 $state = "tags";                  $state = "tags";
                 ($branch = $head) =~ s/\.\d+$// if (!defined($branch));                  ($branch = $head) =~ s/\.\d+$// if $branch eq '';
                 $branch =~ s/(\d+)$/0.$1/;                  $branch =~ s/(\d+)$/0.$1/;
                 $symrev{MAIN} = $branch;                  $symrev{MAIN} = $branch;
                 $symrev{HEAD} = $branch;                  $symrev{HEAD} = $branch;
Line 1875  again:
Line 1918  again:
                 push (@filetags, "MAIN", "HEAD");                  push (@filetags, "MAIN", "HEAD");
             } elsif (/$LOG_REVSEPARATOR/o) {              } elsif (/$LOG_REVSEPARATOR/o) {
                 $state = "log";                  $state = "log";
                 $rev = undef;                  $rev = '';
                 $date = undef;                  $date = '';
                 $log = "";                  $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/%%;
             }              }
Line 1895  again:
Line 1938  again:
                         $revwanted = $symrev{$tag eq "HEAD" ? "MAIN" : $tag};                          $revwanted = $symrev{$tag eq "HEAD" ? "MAIN" : $tag};
                         ($branch = $revwanted) =~ s/\b0\.//;                          ($branch = $revwanted) =~ s/\b0\.//;
                         ($branchpoint = $branch) =~ s/\.?\d+$//;                          ($branchpoint = $branch) =~ s/\.?\d+$//;
                         $revwanted = undef if ($revwanted ne $branch);                          $revwanted = '' if ($revwanted ne $branch);
                     } elsif ($tag ne "HEAD") {                      } elsif ($tag ne "HEAD") {
                         print "Tag not found, skip this file" if ($verbose);                          print "Tag not found, skip this file" if ($verbose);
                         $state = "skip";                          $state = "skip";
Line 1912  again:
Line 1955  again:
         if ($state eq "log") {          if ($state eq "log") {
             if (/$LOG_REVSEPARATOR/o || /$LOG_FILESEPARATOR/o) {              if (/$LOG_REVSEPARATOR/o || /$LOG_FILESEPARATOR/o) {
                 # End of a log entry.                  # End of a log entry.
                 my $revbranch;                  my $revbranch = $rev;
                 ($revbranch = $rev) =~ s/\.\d+$//;                  $revbranch =~ s/\.\d+$//;
                 print "$filename $rev Wanted: $revwanted ",                  print "$filename $rev Wanted: $revwanted ",
                   "Revbranch: $revbranch Branch: $branch ",                    "Revbranch: $revbranch Branch: $branch ",
                     "Branchpoint: $branchpoint\n" if ($verbose);                      "Branchpoint: $branchpoint\n" if ($verbose);
                 if (!defined($revwanted) && defined($branch)                  if ($revwanted eq '' && $branch ne ''
                     && $branch eq $revbranch || !defined($tag)) {                      && $branch eq $revbranch || !defined($tag)) {
                     print "File revision $rev found for branch $branch\n"                      print "File revision $rev found for branch $branch\n"
                         if ($verbose);                          if ($verbose);
                     $revwanted = $rev;                      $revwanted = $rev;
                 }                  }
                 if (defined($revwanted) ? $rev eq $revwanted :                  if ($revwanted ne '' ? $rev eq $revwanted :
                     defined($branchpoint) ? $rev eq $branchpoint :                      $branchpoint ne '' ? $rev eq $branchpoint :
                     0 && ($rev eq $head)) { # Don't think head is needed here..                      0 && ($rev eq $head)) { # Don't think head is needed here..
                     print "File info $rev found for $filename\n" if ($verbose);                      print "File info $rev found for $filename\n" if ($verbose);
                     my @finfo = ($rev,$date,$log,$author,$filename);                      my @finfo = ($rev,$date,$log,$author,$filename);
Line 1933  again:
Line 1976  again:
                     $fileinfo{$name} = [ @finfo ];                      $fileinfo{$name} = [ @finfo ];
                     $state = "done" if ($rev eq $revwanted);                      $state = "done" if ($rev eq $revwanted);
                 }                  }
                 $rev = undef;                  $rev = '';
                 $date = undef;                  $date = '';
                 $log = "";                  $log = '';
             }              }
             elsif (!defined($date) && m|^date:\s+(\d+)/(\d+)/(\d+)\s+(\d+):(\d+):(\d+);|) {              elsif ($date eq '' && m|^date:\s+(\d+)/(\d+)/(\d+)\s+(\d+):(\d+):(\d+);|) {
                 my $yr = $1;                  my $yr = $1;
                 # damn 2-digit year routines :-)                  # damn 2-digit year routines :-)
                 if ($yr > 100) {                  if ($yr > 100) {
Line 1949  again:
Line 1992  again:
                 $log = '';                  $log = '';
                 next;                  next;
             }              }
             elsif (!defined($rev) && m/^revision (.*)$/) {              elsif ($rev eq '' && /^revision (.*)$/) {
                 $rev = $1;                  $rev = $1;
                 next;                  next;
             }              }
Line 1964  again:
Line 2007  again:
     }      }
     if ($. == 0) {      if ($. == 0) {
         fatal("500 Internal Error",          fatal("500 Internal Error",
               "Failed to spawn GNU rlog on <em>'".join(", ", @files)."'</em><p>did you set the <b>\$ENV{PATH}</b> in your configuration file correctly ?");                "Failed to spawn GNU rlog on <em>'".join(", ", @files)."'</em><p>Did you set the <b>\$command_path</b> in your configuration file correctly ? (Currently '$command_path'");
     }      }
     close($fh);      close($fh);
 }  }
Line 1992  sub readLog($;$) {
Line 2035  sub readLog($;$) {
   
         print("Going to rlog '$fullname'\n") if ($verbose);          print("Going to rlog '$fullname'\n") if ($verbose);
         if (! open($fh, "-|")) { # child          if (! open($fh, "-|")) { # child
                 if ($revision ne '') {              if ($revision ne '') {
                         exec("rlog",$revision,$fullname);                  exec($CMD{rlog}, $revision, $fullname);
                 }              }
                 else {              else {
                         exec("rlog",$fullname);                  exec($CMD{rlog}, $fullname);
                 }              }
         }          }
         while (<$fh>) {          while (<$fh>) {
             print if ($verbose);              print if ($verbose);
Line 2357  sub printLog($;$) {
Line 2400  sub printLog($;$) {
             if (/^\d+\.\d+\.\d+/ && !/^1\.1\.1\.\d+$/) {              if (/^\d+\.\d+\.\d+/ && !/^1\.1\.1\.\d+$/) {
                 my ($i,$nextmain);                  my ($i,$nextmain);
                 for ($i = 0; $i < $#revorder && $revorder[$i] ne $_; $i++){}                  for ($i = 0; $i < $#revorder && $revorder[$i] ne $_; $i++){}
                 my (@tmp2) = split(/\./, $_);                  my @tmp2 = split(/\./, $_);
                 for ($nextmain = ""; $i > 0; $i--) {                  for ($nextmain = ""; $i > 0; $i--) {
                     my ($next) = $revorder[$i-1];                      my $next = $revorder[$i-1];
                     my (@tmp1) = split(/\./, $next);                      my @tmp1 = split(/\./, $next);
                     if ($#tmp1 < $#tmp2) {                      if (@tmp1 < @tmp2) {
                         $nextmain = $next;                          $nextmain = $next;
                         last;                          last;
                     }                      }
                     # Only the highest version on a branch should have                      # Only the highest version on a branch should have
                     # a diff for the "next main".                      # a diff for the "next main".
                     last if (join(".",@tmp1[0..$#tmp1-1])                      last if (@tmp1 - 1 <= @tmp2 &&
                              eq join(".",@tmp2[0..$#tmp1-1]));                               join(".",@tmp1[0..$#tmp1-1]) eq join(".",@tmp2[0..$#tmp1-1]));
                 }                  }
                 if (!defined($diffrev{$nextmain})) {                  if (!defined($diffrev{$nextmain})) {
                     $diffrev{$nextmain} = 1;                      $diffrev{$nextmain} = 1;
Line 2715  sub navigateHeader($$$$$) {
Line 2758  sub navigateHeader($$$$$) {
     my ($swhere,$path,$filename,$rev,$title) = @_;      my ($swhere,$path,$filename,$rev,$title) = @_;
     $swhere = "" if ($swhere eq $scriptwhere);      $swhere = "" if ($swhere eq $scriptwhere);
     $swhere = urlencode($filename) if ($swhere eq "");      $swhere = urlencode($filename) if ($swhere eq "");
     print qq`<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">`;  
     print "<HTML>\n<HEAD>\n";      print <<EOF;
     print qq`<META name="robots" content="nofollow">\n`;  <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
     print '<!-- CVSweb $zRevision: 1.104 $  $kRevision: 1.49 $ -->';  <HTML>
     print "\n<TITLE>$path$filename - $title - $rev</TITLE></HEAD>\n";  <HEAD>
     print  "$body_tag_for_src\n";  <META name="robots" content="nofollow">
     print "<table width=\"100%\" border=0 cellspacing=0 cellpadding=1 bgcolor=\"$navigationHeaderColor\">";  <!-- knu-cvsweb $cvsweb_revision -->
     print "<tr valign=bottom><td>";  <TITLE>$path$filename - $title - $rev</TITLE></HEAD>
   $body_tag_for_src
   <table width="100%" border=0 cellspacing=0 cellpadding=1 bgcolor="$navigationHeaderColor">
   <tr valign=bottom><td>
   EOF
   
     print &link($backicon, "$swhere$query#rev$rev");      print &link($backicon, "$swhere$query#rev$rev");
     print "</a> <b>Return to ", &link("$filename","$swhere$query#rev$rev")," CVS log";      print "</a> <b>Return to ", &link("$filename","$swhere$query#rev$rev")," CVS log";
     print "</b> $fileicon</td>";      print "</b> $fileicon</td>";
Line 2832  sub clickablePath($$) {
Line 2880  sub clickablePath($$) {
 }  }
   
 sub chooseCVSRoot() {  sub chooseCVSRoot() {
     my @foo;      if (2 <= @CVSROOT) {
     foreach (sort keys %CVSROOT) {  
         if (-d $CVSROOT{$_}) {  
             push(@foo, $_);  
         }  
     }  
     if (@foo > 1) {  
         my ($k);          my ($k);
         print "<form method=\"GET\" action=\"${scriptwhere}\">\n";          print "<form method=\"GET\" action=\"${scriptwhere}\">\n";
         foreach $k (keys %input) {          foreach $k (keys %input) {
Line 2853  sub chooseCVSRoot() {
Line 2895  sub chooseCVSRoot() {
         print "<td>\n<select name=\"cvsroot\"";          print "<td>\n<select name=\"cvsroot\"";
         print " onchange=\"submit()\"" if ($use_java_script);          print " onchange=\"submit()\"" if ($use_java_script);
         print ">\n";          print ">\n";
         foreach $k (@foo) {          foreach $k (@CVSROOT) {
             print "<option value=\"$k\"";              print "<option value=\"$k\"";
             print " selected" if ($k eq $cvstree);              print " selected" if ($k eq $cvstree);
             print ">", ($CVSROOTdescr{$k} ? $CVSROOTdescr{$k} : $k), "</option>\n";              print ">", ($CVSROOTdescr{$k} ? $CVSROOTdescr{$k} : $k), "</option>\n";
         }          }
         print "</select>\n</td>";          print "</select>\n</td>";
         print "<td><input type=submit value=\"Go\"></td>";          print "<td>";
         print "</tr></table></form>";  
     }      }
     else {      else {
         # no choice ..          # no choice ..
         print "CVS Root: <b>[$cvstree]</b>";          print "CVS Root: <b>[$cvstree]</b>";
     }      }
   
       print " Module path or alias:\n";
       print "<INPUT TYPE=TEXT NAME=\"path\" VALUE=\"\" SIZE=15>\n";
       print "<input type=submit value=\"Go\">";
   
       if (2 <= @CVSROOT) {
           print "</td></tr></table></form>";
       }
 }  }
   
 sub chooseMirror() {  sub chooseMirror() {
Line 3052  sub hrefquote($) {
Line 3101  sub hrefquote($) {
   
 sub http_header(;$) {  sub http_header(;$) {
     my $content_type = shift || "text/html";      my $content_type = shift || "text/html";
   
       $content_type .= "; charset=$charset"
         if $content_type =~ m,^text/, && defined($charset) && $charset;
   
     if (defined($moddate)) {      if (defined($moddate)) {
         if ($is_mod_perl) {          if ($is_mod_perl) {
             Apache->request->header_out("Last-Modified" => scalar gmtime($moddate) . " GMT");              Apache->request->header_out("Last-Modified" => scalar gmtime($moddate) . " GMT");
Line 3067  sub http_header(;$) {
Line 3120  sub http_header(;$) {
             print "Content-type: $content_type\r\n";              print "Content-type: $content_type\r\n";
     }      }
     if ($allow_compress && $maycompress) {      if ($allow_compress && $maycompress) {
         if ($has_zlib || (defined($GZIPBIN) && open(GZIP, "|$GZIPBIN -1 -c"))) {          if ($has_zlib || (defined($CMD{gzip}) && open(GZIP, "| $CMD{gzip} -1 -c"))) {
             if ($is_mod_perl) {              if ($is_mod_perl) {
                     Apache->request->content_encoding("x-gzip");                      Apache->request->content_encoding("x-gzip");
                     Apache->request->header_out(Vary => "Accept-Encoding");                      Apache->request->header_out(Vary => "Accept-Encoding");
Line 3093  sub http_header(;$) {
Line 3146  sub http_header(;$) {
             else {              else {
                     print "\r\n"; # Close headers                      print "\r\n"; # Close headers
             }              }
             print "<font size=-1>Unable to find gzip binary in the \$PATH to compress output</font><br>";              print "<font size=-1>Unable to find gzip binary in the <b>\$command_path</b> ($command_path) to compress output</font><br>";
         }          }
     }      }
     else {      else {
Line 3108  sub http_header(;$) {
Line 3161  sub http_header(;$) {
   
 sub html_header($) {  sub html_header($) {
     my ($title) = @_;      my ($title) = @_;
     my $version = '$zRevision: 1.104 $  $kRevision: 1.49 $'; #'      http_header("text/html");
     http_header(defined($charset) ? "text/html; charset=$charset" : "text/html");  
     print <<EOH;      print <<EOH;
 <!doctype html public "-//W3C//DTD HTML 4.0 Transitional//EN"  <!doctype html public "-//W3C//DTD HTML 4.0 Transitional//EN"
  "http://www.w3.org/TR/REC-html40/loose.dtd">   "http://www.w3.org/TR/REC-html40/loose.dtd">
Line 3117  sub html_header($) {
Line 3169  sub html_header($) {
 <head>  <head>
 <meta name="robots" content="nofollow">  <meta name="robots" content="nofollow">
 <title>$title</title>  <title>$title</title>
 <!-- CVSweb $version -->  <!-- knu-cvsweb $cvsweb_revision -->
 </head>  </head>
 $body_tag  $body_tag
 $logo <h1 align="center">$title</h1>  $logo <h1 align="center">$title</h1>

Legend:
Removed from v.1.1.1.17  
changed lines
  Added in v.1.1.1.22

CVSweb