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

Diff for /cvsweb/cvsweb.cgi between version 4.20 and 4.32

version 4.20, 2019/11/11 15:46:39 version 4.32, 2019/11/29 15:05:26
Line 57  use vars qw (
Line 57  use vars qw (
   $VERSION $CheckoutMagic $MimeTypes $DEBUG    $VERSION $CheckoutMagic $MimeTypes $DEBUG
   $config $allow_version_select    $config $allow_version_select
   @CVSrepositories @CVSROOT %CVSROOT %CVSROOTdescr    @CVSrepositories @CVSROOT %CVSROOT %CVSROOTdescr
   %MIRRORS %DEFAULTVALUE %ICONS %MTYPES    %DEFAULTVALUE %ICONS %MTYPES
   %DIFF_COMMANDS @DIFFTYPES %DIFFTYPES @LOGSORTKEYS %LOGSORTKEYS    %DIFF_COMMANDS @DIFFTYPES %DIFFTYPES @LOGSORTKEYS %LOGSORTKEYS
   %alltags %fileinfo %tags @branchnames %nameprinted    %alltags %fileinfo %tags @branchnames %nameprinted
   %symrev %revsym @allrevisions %date %author @revdisplayorder    %symrev %revsym @allrevisions %date %author @revdisplayorder
Line 67  use vars qw (
Line 67  use vars qw (
   $is_links $is_lynx $is_w3m $is_msie $is_mozilla3 $is_textbased    $is_links $is_lynx $is_w3m $is_msie $is_mozilla3 $is_textbased
   %input $query $barequery $sortby $bydate $byrev $byauthor    %input $query $barequery $sortby $bydate $byrev $byauthor
   $bylog $byfile $defaultDiffType $logsort $cvstree $cvsroot    $bylog $byfile $defaultDiffType $logsort $cvstree $cvsroot
   $charset $output_filter    $charset $output_filter %CMD $allow_compress $backicon $diricon $fileicon
   @command_path %CMD $allow_compress $backicon $diricon $fileicon    $fullname $logo $defaulttitle $address $binfileicon
   $fullname $cvstreedefault $logo $defaulttitle $address $binfileicon    $shortLogLen $show_author
   $long_intro $short_instruction $shortLogLen $show_author  
   $tablepadding $hr_breakable $showfunc $hr_ignwhite $hr_ignkeysubst    $tablepadding $hr_breakable $showfunc $hr_ignwhite $hr_ignkeysubst
   $inputTextSize $mime_types $allow_annotate $allow_markup $allow_mailtos    $inputTextSize $mime_types $allow_annotate $allow_markup $allow_mailtos
   $allow_log_extra $allow_dir_extra $allow_source_extra    $allow_log_extra $allow_dir_extra $allow_source_extra
   $edit_option_form    $edit_option_form
   $show_subdir_lastmod $show_log_in_markup $preformat_in_markup    $show_subdir_lastmod $show_log_in_markup $preformat_in_markup
   $tabstop $state $annTable $sel @ForbiddenFiles    $tabstop $state $annTable $sel @ForbiddenFiles
   $use_descriptions %descriptions @mytz $dwhere    $use_descriptions %descriptions $dwhere
   $use_moddate $gzip_open $file_list_len    $use_moddate $gzip_open $file_list_len
   $allow_tar @tar_options @gzip_options @zip_options @cvs_options    $allow_tar @tar_options @cvs_options
   @annotate_options @rcsdiff_options    @annotate_options @rcsdiff_options
   $HTML_DOCTYPE $HTML_META $cssurl $CSS $cvshistory_url    $HTML_DOCTYPE $HTML_META $cssurl $CSS
 );  );
   
 require Compress::Zlib;  require Compress::Zlib;
Line 129  EOM
Line 128  EOM
   $MimeTypes = undef if $@;    $MimeTypes = undef if $@;
   
   $CheckoutMagic = '~checkout~';    $CheckoutMagic = '~checkout~';
     $CMD{$_} = "/usr/bin/$_" for (qw(cvs rcsdiff rlog));
     $CMD{tar} = "/bin/tar";
 }  }
   
 # -----------------------------------------------------------------------------  # -----------------------------------------------------------------------------
Line 144  sub spacedHtmlText($;$);
Line 145  sub spacedHtmlText($;$);
 sub link($$);  sub link($$);
 sub revcmp($$);  sub revcmp($$);
 sub fatal($$@);  sub fatal($$@);
 sub config_error($$);  
 sub redirect($;$);  sub redirect($;$);
 sub safeglob($);  sub safeglob($);
 sub search_path($);  sub search_path($);
Line 168  sub plural_write($$);
Line 168  sub plural_write($$);
 sub readableTime($$);  sub readableTime($$);
 sub clickablePath($$);  sub clickablePath($$);
 sub chooseCVSRoot();  sub chooseCVSRoot();
 sub chooseMirror();  
 sub fileSortCmp();  sub fileSortCmp();
 sub download_url($$;$);  sub download_url($$;$);
 sub download_link($$$;$);  sub download_link($$$;$);
 sub display_url($$;$);  sub display_url($$;$);
 sub display_link($$;$$);  sub display_link($$;$$);
 sub history_link($$;$);  
 sub toggleQuery($;$);  sub toggleQuery($;$);
 sub htmlquote($);  sub htmlquote($);
 sub htmlunquote($);  sub htmlunquote($);
Line 192  sub checkout_to_temp($$$);
Line 190  sub checkout_to_temp($$$);
 # (think mod_perl)...  # (think mod_perl)...
 delete(@ENV{qw(PATH IFS CDPATH ENV BASH_ENV)});  delete(@ENV{qw(PATH IFS CDPATH ENV BASH_ENV)});
   
   # Helps to achieve read only access to the repositories
   # with cvs >= 1.12.1 and doesn't hurt other versions.
   $ENV{CVSREADONLYFS} = 1;
   
 # Location of the configuration file inside the web server chroot:  # Location of the configuration file inside the web server chroot:
 $config = '/conf/cvsweb/cvsweb.conf';  $config = '/conf/cvsweb/cvsweb.conf';
   
 ######## Configuration parameters #########  ######## Configuration parameters #########
   
 @CVSrepositories = @CVSROOT = %CVSROOT = %MIRRORS = %DEFAULTVALUE = %ICONS =  @CVSrepositories = @CVSROOT = %CVSROOT = %DEFAULTVALUE = %ICONS =
   %MTYPES = %tags = %alltags = %fileinfo = %DIFF_COMMANDS = ();    %MTYPES = %tags = %alltags = %fileinfo = %DIFF_COMMANDS = ();
   
 $cvstreedefault = $logo = $defaulttitle =  $logo = $defaulttitle =
   $address = $long_intro = $short_instruction = $shortLogLen = $show_author =    $address = $shortLogLen = $show_author =
   $tablepadding = $hr_breakable = $showfunc = $hr_ignwhite =    $tablepadding = $hr_breakable = $showfunc = $hr_ignwhite =
   $hr_ignkeysubst = $inputTextSize = $mime_types = $allow_annotate =    $hr_ignkeysubst = $inputTextSize = $mime_types = $allow_annotate =
   $allow_markup = $allow_compress = $edit_option_form =    $allow_markup = $allow_compress = $edit_option_form =
   $show_subdir_lastmod = $show_log_in_markup = $preformat_in_markup =    $show_subdir_lastmod = $show_log_in_markup = $preformat_in_markup =
   $tabstop = $use_moddate = $gzip_open = $DEBUG =    $tabstop = $use_moddate = $gzip_open = $DEBUG =
   $cvshistory_url = $allow_tar = undef;    $allow_tar = undef;
   
 $allow_version_select = $allow_mailtos = $allow_log_extra = 1;  $allow_version_select = $allow_mailtos = $allow_log_extra = 1;
   
Line 263  $scriptname    = '' unless defined($scriptname);
Line 265  $scriptname    = '' unless defined($scriptname);
 $where         =  $pathinfo;  $where         =  $pathinfo;
 $doCheckout    =  $where =~ s|^/$CheckoutMagic/|/|o;  $doCheckout    =  $where =~ s|^/$CheckoutMagic/|/|o;
 $where         =~ s|^/||;  $where         =~ s|^/||;
 $scriptname    =~ s|^/*|/|;  $scriptname    =~ s|^/+||;
   
 # Let's workaround thttpd's stupidity..  # Let's workaround thttpd's stupidity..
 if ($scriptname =~ m|/$|) {  if ($scriptname =~ m|/$|) {
Line 271  if ($scriptname =~ m|/$|) {
Line 273  if ($scriptname =~ m|/$|) {
   my $re = quotemeta $pathinfo;    my $re = quotemeta $pathinfo;
   $scriptname =~ s/$re$//;    $scriptname =~ s/$re$//;
 }  }
   $scriptname = "/$scriptname" if $scriptname;
   
 # $scriptname : the URI escaped path to this script  # $scriptname : the URI escaped path to this script
 # $where      : the path in the CVS repository (without leading /, or only /)  # $where      : the path in the CVS repository (without leading /, or only /)
Line 315  $maycompress = (
Line 318  $maycompress = (
   qw(cvsroot hideattic ignorecase sortby logsort f only_with_tag ln    qw(cvsroot hideattic ignorecase sortby logsort f only_with_tag ln
      hidecvsroot hidenonreadable);       hidecvsroot hidenonreadable);
   
 #  
 # Load configuration.  # Load configuration.
 #  {
 if (-f $config) {    $config =~ m|^/| or fatal '500 Internal Error',
   do "$config" or config_error($config, $@);      'Configuration file name "<code>%s</code>" is not an absolute path.',
 } else {      $config;
   fatal("500 Internal Error",    defined do $config and last;
         'Configuration not found.  Set the parameter <code>$config</code> in cvsweb.cgi to your <b>cvsweb.conf</b> configuration file first.');    $@ and fatal '500 Internal Error',
       'Error loading configuration file "<code>%s</code>": <pre>%s</pre>',
       $config, $@;
     fatal '500 Internal Error',
       'Cannot read configuration file "<code>%s</code>": %s',
       $config, $! || 'unknown error';
 }  }
   
 # Try to find a readable dir where we can cd into.  Some abs_path()  # Try to find a readable dir where we can cd into.  Some abs_path()
Line 469  for (my $i = 0; $i < scalar(@CVSrepositories); $i += 2
Line 476  for (my $i = 0; $i < scalar(@CVSrepositories); $i += 2
     next;      next;
   }    }
   $rootfound ||= 1;    $rootfound ||= 1;
   $cvstreedefault = $key unless defined($cvstreedefault);  
   $CVSROOTdescr{$key} = $descr;    $CVSROOTdescr{$key} = $descr;
   $CVSROOT{$key} = $root;    $CVSROOT{$key} = $root;
   push(@CVSROOT, $key);    push(@CVSROOT, $key);
Line 482  unless ($rootfound) {
Line 488  unless ($rootfound) {
 }  }
 undef $rootfound;  undef $rootfound;
   
 #  $DEFAULTVALUE{cvsroot} = $CVSrepositories[0];
 # Default CVS root  
 #  
 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;  
   
 while (my ($key, $defval) = each %DEFAULTVALUE) {  while (my ($key, $defval) = each %DEFAULTVALUE) {
   
   # Replace not given parameters with defaults.    # Replace not given parameters with defaults.
Line 573  $logsort = $input{logsort};
Line 567  $logsort = $input{logsort};
 if ($input{cvsroot} && $CVSROOT{$input{cvsroot}}) {  if ($input{cvsroot} && $CVSROOT{$input{cvsroot}}) {
   $cvstree = $input{cvsroot};    $cvstree = $input{cvsroot};
 } else {  } else {
   $cvstree = $cvstreedefault;    $cvstree = $CVSrepositories[0];
 }  }
   
 $cvsroot = $CVSROOT{$cvstree};  $cvsroot = $CVSROOT{$cvstree};
Line 647  if ($input{tarball}) {
Line 641  if ($input{tarball}) {
   
   my ($module)  =  ($where =~ m,^/?(.*),);    # untaint    my ($module)  =  ($where =~ m,^/?(.*),);    # untaint
   $module       =~ s,/([^/]*)$,,;    $module       =~ s,/([^/]*)$,,;
   my ($ext)     =  ($1 =~ /(\.t(?:ar\.)?gz|\.zip)$/);    my ($ext)     =  ($1 =~ /(\.t(?:ar\.)?gz)$/);
   my ($basedir) =  ($module =~ m,([^/]+)$,);    my ($basedir) =  ($module =~ m,([^/]+)$,);
   
   if ($basedir eq '' || $module eq '') {    if ($basedir eq '' || $module eq '') {
Line 655  if ($input{tarball}) {
Line 649  if ($input{tarball}) {
           'You cannot download the top level directory.');            'You cannot download the top level directory.');
   }    }
   
   my $istar = ($ext eq '.tar.gz' || $ext eq '.tgz');    unless ($ext eq '.tar.gz' || $ext eq '.tgz') {
   if ($istar) {      fatal('404 Not Found', 'Unsupported archive type.');
     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 $tmpexportdir;    my $tmpexportdir;
   eval {    eval {
Line 697  if ($input{tarball}) {
Line 682  if ($input{tarball}) {
       ('500 Internal Error',        ('500 Internal Error',
        'Export failure (exit status %s), output: <pre>%s</pre>',         'Export failure (exit status %s), output: <pre>%s</pre>',
        $errcode, $err || $export_err);         $errcode, $err || $export_err);
   
   } else {    } else {
   
     $| = 1;    # Essential to get the buffering right.      $| = 1;    # Essential to get the buffering right.
     local (*TAR_OUT);      local (*TAR_OUT);
       my ($h, $err) = startproc($CMD{tar}, @tar_options, '-czf', '-',
     my (@cmd, $ctype);        $basedir, '>pipe', \*TAR_OUT);
     if ($istar) {  
       my @tar = ($CMD{tar}, @tar_options, '-cf', '-', $basedir);  
       my @gzip = ($CMD{gzip}, @gzip_options, '-c');  
       push(@cmd, \@tar, '|', \@gzip);  
       $ctype = 'application/x-gzip';  
     } elsif ($iszip) {  
       my @zip = ($CMD{zip}, @zip_options, '-r', '-', $basedir);  
       push(@cmd, \@zip, \'');  
       $ctype = 'application/zip';  
     }  
     push(@cmd, '>pipe', \*TAR_OUT);  
   
     my ($h, $err) = startproc(@cmd);  
     if ($h) {      if ($h) {
       print "Content-Type: $ctype\r\n\r\n";        print "Content-Type: application/x-gzip\r\n\r\n";
       local $/ = undef;        local $/ = undef;
       print <TAR_OUT>;        print <TAR_OUT>;
       $h->finish();        $h->finish();
     } else {      } else {
       @fatal = ('500 Internal Error',        @fatal = ('500 Internal Error',
                 '%s failure (exit status %s), output: <pre>%s</pre>',                  'tar failure (exit status %s), output: <pre>%s</pre>',
                 $istar ? 'Tar' : 'Zip', $? >> 8 || -1, $err);                  $? >> 8 || -1, $err);
     }      }
   }    }
   
Line 752  if (-d $fullname) {
Line 722  if (-d $fullname) {
   
   if ($where eq '/') {    if ($where eq '/') {
     html_header($defaulttitle);      html_header($defaulttitle);
     $long_intro =~ s/!!CVSROOTdescr!!/$CVSROOTdescr{$cvstree}/g;  
     print $long_intro;  
   } else {    } else {
     html_header($where);      html_header($where);
     my $html = (-f catfile($fullname, 'README.cvs.html,v') ||      my $html = (-f catfile($fullname, 'README.cvs.html,v') ||
Line 790  if (-d $fullname) {
Line 758  if (-d $fullname) {
       }        }
       $h->finish();        $h->finish();
     }      }
     print $short_instruction;  
   }    }
   
   if ($use_descriptions &&    if ($use_descriptions &&
Line 807  if (-d $fullname) {
Line 774  if (-d $fullname) {
   
   # give direct access to dirs    # give direct access to dirs
   if ($where eq '/') {    if ($where eq '/') {
     chooseMirror();  
     chooseCVSRoot();      chooseCVSRoot();
   
   } else {    } else {
     print '<p>Current directory: <b>', clickablePath($where, 0), '</b>';      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>\n";
     print "<p>Current tag: <b>", htmlquote($input{only_with_tag}), "</b></p>\n"      print "<p>Current tag: <b>", htmlquote($input{only_with_tag}), "</b></p>\n"
       if $input{only_with_tag};        if $input{only_with_tag};
Line 1120  EOF
Line 1081  EOF
   
   if ($allow_tar && $filesfound) {    if ($allow_tar && $filesfound) {
     my ($basefile) = ($where =~ m,(?:.*/)?([^/]+),);      my ($basefile) = ($where =~ m,(?:.*/)?([^/]+),);
     my $havetar = $CMD{tar} && $CMD{gzip};      if (defined($basefile) && $basefile ne '') {
     my $havezip = $CMD{zip};  
     if (defined($basefile) && $basefile ne '' && ($havetar || $havezip)) {  
       my $q = ($query ? "$query;" : '?') . 'tarball=1';        my $q = ($query ? "$query;" : '?') . 'tarball=1';
       print "<hr />\n",        print "<hr />\n",
         '<div style="text-align: center">Download this directory in ';          '<div style="text-align: center">Download this directory in ';
       # Mangle the filename so browsers show a reasonable filename to download.        # Mangle the filename so browsers show a reasonable filename to download.
       my @types = ();  
       $basefile = uri_escape($basefile);        $basefile = uri_escape($basefile);
       push(@types, &link('tarball', "$basefile.tar.gz$q")) if $havetar;        print &link('tarball', "$basefile.tar.gz$q");
       push(@types, &link('zip archive', "$basefile.zip$q")) if $havezip;        print "</div>\n";
       print join(' or ', @types), "</div>\n";  
     }      }
   }    }
   
Line 1147  EOF
Line 1104  EOF
       printf(qq{<input type="hidden" name="%s" value="%s" />\n},        printf(qq{<input type="hidden" name="%s" value="%s" />\n},
              $v, $input{$v} || 0);               $v, $input{$v} || 0);
     }      }
     if ($cvstree ne $cvstreedefault) {      if ($cvstree ne $CVSrepositories[0]) {
       print "<input type=\"hidden\" name=\"cvsroot\" value=\"$cvstree\" />\n";        print "<input type=\"hidden\" name=\"cvsroot\" value=\"$cvstree\" />\n";
     }      }
     print <<EOF;      print <<EOF;
Line 1545  sub fatal($$@)
Line 1502  sub fatal($$@)
   
   
 #  #
 # Signal a (fatal) configuration error.  
 #  
 sub config_error($$)  
 {  
   fatal('500 Internal Error',  
         'Error loading configuration file "<code>%s</code>":<br /><br />' .  
         '%s<br />', @_);  
 }  
   
   
 #  
 # Sends a redirect to the given URL.  # Sends a redirect to the given URL.
 #  #
 sub redirect($;$)  sub redirect($;$)
Line 1612  sub safeglob($)
Line 1558  sub safeglob($)
   
   
 #  #
 # 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 MIME type for the given file name.  # Gets the MIME type for the given file name.
 #  #
 sub getMimeType($;$)  sub getMimeType($;$)
Line 2464  sub getDirLogs($$@)
Line 2396  sub getDirLogs($$@)
   
   if ($linesread == 0) {    if ($linesread == 0) {
     fatal('500 Internal Error',      fatal('500 Internal Error',
           'Failed to spawn GNU rlog on <em>"%s"</em>.<br /><br />Did you set the <b><code>@command_path</code></b> in your configuration file correctly? (Currently: "<code>%s</code>")',            'Failed to spawn rlog on <em>"%s"</em>',
           htmlquote(join(', ', @files)), join(':', @command_path));            htmlquote(join(', ', @files)));
   }    }
   
   return @unreadable;    return @unreadable;
 }  }
   
Line 2787  sub printLog($$$;$$)
Line 2718  sub printLog($$$;$$)
   print "<br />\n";    print "<br />\n";
   
   print '<i>';    print '<i>';
   if (@mytz) {    print scalar gmtime($date{$_}), ' UTC</i> (';
     my ($est) = $mytz[(localtime($date{$_}))[8]];  
     print scalar localtime($date{$_}), " $est</i> (";  
   } else {  
     print scalar gmtime($date{$_}), " UTC</i> (";  
   }  
   print readableTime(time() - $date{$_}, 1), ' ago)';    print readableTime(time() - $date{$_}, 1), ' ago)';
   print ' by <i>', htmlquote($author{$_}), "</i><br />\n";    print ' by <i>', htmlquote($author{$_}), "</i><br />\n";
   
Line 2939  sub doLog($)
Line 2865  sub doLog($)
     &clickablePath($upwhere, 1), "</b>\n</p>\n";      &clickablePath($upwhere, 1), "</b>\n</p>\n";
   print "<p>\n ";    print "<p>\n ";
   print &link('Request diff between arbitrary revisions', '#diff');    print &link('Request diff between arbitrary revisions', '#diff');
   if ($cvshistory_url) {  
     (my $d = $upwhere) =~ s|/+$||;  
     print ' - ', history_link($d, $filename);  
   }  
   print "\n</p>\n<hr />\n";    print "\n</p>\n<hr />\n";
   
   print "<p>\n";    print "<p>\n";
Line 3528  EOF
Line 3450  EOF
 }  }
   
   
 sub chooseMirror()  
 {  
   # This code comes from the original BSD-cvsweb  
   # and may not be useful for your site; If you don't  
   # set %MIRRORS this won't show up, anyway.  
   scalar(%MIRRORS) or return;  
   
   # Should perhaps exclude the current site somehow...  
   print "\n<p>\nThis CVSweb is mirrored in\n";  
   
   my @tmp = map(&link(htmlquote($_), $MIRRORS{$_}), sort keys %MIRRORS);  
   my $tmp = pop (@tmp);  
   
   if (scalar(@tmp)) {  
     print join (', ', @tmp), ' and ';  
   }  
   
   print "$tmp.\n</p>\n";  
 }  
   
   
 sub fileSortCmp()  sub fileSortCmp()
 {  {
   (my $af = $a) =~ s/,v$//;    (my $af = $a) =~ s/,v$//;
Line 3673  sub display_link($$;$$)
Line 3574  sub display_link($$;$$)
   return sprintf('<a href="%s" class="display-link">%s</a>',    return sprintf('<a href="%s" class="display-link">%s</a>',
                  display_url($url, $revision, $mtype) . $barequery,                   display_url($url, $revision, $mtype) . $barequery,
                  htmlquote($textlink));                   htmlquote($textlink));
 }  
   
 #  
 # Returns a link to CVSHistory for the given directory and filename.  
 #  
 sub history_link($$;$)  
 {  
   my ($dir, $file, $text) = @_;  
   $dir  ||= '';  
   $file ||= '';  
   $text ||= 'History';  
   return &link($text,  
                sprintf('%s?cvsroot=%s;dsearch=%s;fsearch=%s;limit=1',  
                        $cvshistory_url, uri_escape($input{cvsroot} || ''),  
                        uri_escape($dir), uri_escape($file)));  
 }  }
   
 # Returns a Query string with the  # Returns a Query string with the

Legend:
Removed from v.4.20  
changed lines
  Added in v.4.32

CVSweb