[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.18 and 1.1.1.20

version 1.1.1.18, 2001/01/01 23:55:44 version 1.1.1.20, 2001/01/03 03:36:03
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 43 
Line 43 
 # SUCH DAMAGE.  # SUCH DAMAGE.
 #  #
 # $zId: cvsweb.cgi,v 1.104 2000/11/01 22:05:12 hnordstrom Exp $  # $zId: cvsweb.cgi,v 1.104 2000/11/01 22:05:12 hnordstrom Exp $
 # $kId: cvsweb.cgi,v 1.54 2001/01/01 23:15:02 knu Exp $  # $kId: cvsweb.cgi,v 1.57 2001/01/03 02:55:30 knu Exp $
 #  #
 ###  ###
   
   require 5.000;
   
 use strict;  use strict;
   
 use vars qw (  use vars qw (
     $config $allow_version_select $verbose      $config $allow_version_select $verbose
     %CVSROOT %CVSROOTdescr %MIRRORS %DEFAULTVALUE %ICONS %MTYPES      @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
Line 130  sub link_tags($);
Line 133  sub link_tags($);
 sub forbidden_module($);  sub forbidden_module($);
   
 ##### Start of Configuration Area ########  ##### Start of Configuration Area ########
 use Cwd;  use File::Basename;
   
 # == 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},       (dirname $0) . '/cvsweb.conf',
      '/usr/local/etc/cvsweb.conf',       '/usr/local/etc/cvsweb/cvsweb.conf'
      getcwd() . '/cvsweb.conf'  
     ) {      ) {
     $config = $_ if defined($_) && -r $_;      if (defined($_) && -r $_) {
           ($config) = /(.*)/; # untaint
           last;
       }
 }  }
   
 # == Configuration defaults ==  # == Configuration defaults ==
Line 151  $allow_version_select = 1;
Line 156  $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 355  else {
Line 361  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 392  $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 455  if (-d $fullname) {
Line 480  if (-d $fullname) {
     # to allow relative URL's. If they're not, make a redirect.      # to allow relative URL's. If they're not, make a redirect.
     ##      ##
     if (!($pathinfo =~ m|/$|) || ($pathinfo =~ m |/{2,}$|)) {      if (!($pathinfo =~ m|/$|) || ($pathinfo =~ m |/{2,}$|)) {
         redirect ($scriptwhere . '/' . $query);          redirect("$scriptwhere/$query");
     }      }
     else {      else {
         $where .= '/';          $where .= '/';
Line 482  if ($module && &forbidden_module($module)) {
Line 507  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 497  if ($input{tarball}) {
Line 522  if ($input{tarball}) {
   
     my $fatal = '';      my $fatal = '';
   
     do {      while (1) {
         chdir $tmpdir  
           or $fatal = "500 Internal Error", "Unable to cd to temporary directory: $!"  
             && last;  
   
         my $tag = (exists $input{only_with_tag} && length $input{only_with_tag})          my $tag = (exists $input{only_with_tag} && length $input{only_with_tag})
           ? $input{only_with_tag} : "HEAD";            ? $input{only_with_tag} : "HEAD";
   
         system "cvs", @cvs_options, "-Qd", $cvsroot, "export", "-r", $tag, $where          system "cvs", @cvs_options, "-Qd", $cvsroot, "export", "-r", $tag, "-d", "$tmpdir/$basedir", $module
           and $fatal = "500 Internal Error","cvs co failure: $!: $where"            and $fatal = "500 Internal Error","cvs co failure: $!: $module"
             && 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", "-zcf", "-", $basedir, @tar_options          system "tar", @tar_options, "-zcf", "-", "-C", $tmpdir, $basedir
           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 "rm", "-rf", $tmpdir if -d $tmpdir;
   
Line 871  if (-d $fullname) {
Line 886  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 878  if (-d $fullname) {
Line 895  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 973  if (-d $fullname) {
Line 990  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 993  if (-d $fullname) {
Line 1010  if (-d $fullname) {
             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 1372  sub doAnnotate($$) {
Line 1389  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 @cvs_options -l 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 2721  sub navigateHeader($$$$$) {
Line 2738  sub navigateHeader($$$$$) {
     print qq`<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">`;      print qq`<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">`;
     print "<HTML>\n<HEAD>\n";      print "<HTML>\n<HEAD>\n";
     print qq`<META name="robots" content="nofollow">\n`;      print qq`<META name="robots" content="nofollow">\n`;
     print '<!-- CVSweb $zRevision: 1.104 $  $kRevision: 1.54 $ -->';      print '<!-- CVSweb $zRevision: 1.104 $  $kRevision: 1.57 $ -->';
     print "\n<TITLE>$path$filename - $title - $rev</TITLE></HEAD>\n";      print "\n<TITLE>$path$filename - $title - $rev</TITLE></HEAD>\n";
     print  "$body_tag_for_src\n";      print  "$body_tag_for_src\n";
     print "<table width=\"100%\" border=0 cellspacing=0 cellpadding=1 bgcolor=\"$navigationHeaderColor\">";      print "<table width=\"100%\" border=0 cellspacing=0 cellpadding=1 bgcolor=\"$navigationHeaderColor\">";
Line 2835  sub clickablePath($$) {
Line 2852  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 2856  sub chooseCVSRoot() {
Line 2867  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 3115  sub http_header(;$) {
Line 3133  sub http_header(;$) {
   
 sub html_header($) {  sub html_header($) {
     my ($title) = @_;      my ($title) = @_;
     my $version = '$zRevision: 1.104 $  $kRevision: 1.54 $'; #'      my $version = '$zRevision: 1.104 $  $kRevision: 1.57 $'; #'
     http_header("text/html");      http_header("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"
Legend:
Removed from v.1.1.1.18  
changed lines
  Added in v.1.1.1.20
CVSweb