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

Diff for /cvsweb/cvsweb.cgi between version 1.8 and 1.17

version 1.8, 1997/07/01 22:19:57 version 1.17, 1998/05/05 16:05:32
Line 30  require 'ctime.pl';
Line 30  require 'ctime.pl';
   
 $hsty_base = "";  $hsty_base = "";
 require 'cgi-style.pl';  require 'cgi-style.pl';
   #&get_the_source;
   
 $cvsroot = '/home/ncvs';  %CVSROOT = (
               'freebsd', '/home/ncvs',
               'openbsd', '/home/OpenBSD/cvs',
               'learn', '/c/learncvs',
               'mozilla', '/a/mozilla-cvs',
               );
   
   %CVSROOTdescr = (
               'freebsd', 'FreeBSD',
               'openbsd', 'OpenBSD',
               'learn', 'Learn',
               'mozilla', 'Mozilla FreeBSD',
               );
   
   $cvstreedefault = 'freebsd';
   $cvstree = $cvstreedefault;
   $cvsroot = $CVSROOT{"$cvstree"} || "/home/ncvs";
   
   
 $intro = "  $intro = "
 This is a WWW interface to the FreeBSD CVS tree.  This is a WWW interface to the FreeBSD CVS tree.
 You can browse the file hierarchy by picking directories  You can browse the file hierarchy by picking directories
Line 46  display diffs between arbitrary revisions.
Line 65  display diffs between arbitrary revisions.
 <p>  <p>
 If you would like to use this CGI script on your own web server and  If you would like to use this CGI script on your own web server and
 CVS tree, see <A HREF=\"http://www.freebsd.org/~fenner/cvsweb/\">  CVS tree, see <A HREF=\"http://www.freebsd.org/~fenner/cvsweb/\">
 the CVSWeb distribution site</A>.  the CVSWeb distribution site</A> or the <a
   href=\"http://www.freebsd.org/cgi/cvsweb.cgi/www/data/cgi/cvsweb.cgi\">current</a> FreeBSD version.
 <p>  <p>
 Please send any suggestions, comments, etc. to  Please send any suggestions, comments, etc. to
 <A HREF=\"mailto:fenner@freebsd.org\">Bill Fenner &lt;fenner@freebsd.org&gt;</A>  <A HREF=\"mailto:fenner\@freebsd.org\">Bill Fenner &lt;fenner\@freebsd.org&gt;</A>
 ";  ";
 $shortinstr = "  $shortinstr = "
 Click on a directory to enter that directory. Click on a file to display  Click on a directory to enter that directory. Click on a file to display
Line 60  chance to display diffs between revisions. 
Line 80  chance to display diffs between revisions. 
 $verbose = $v;  $verbose = $v;
 ($where = $ENV{'PATH_INFO'}) =~ s|^/||;  ($where = $ENV{'PATH_INFO'}) =~ s|^/||;
 $where =~ s|/$||;  $where =~ s|/$||;
 $fullname = $cvsroot . '/' . $where;  
 ($scriptname = $ENV{'SCRIPT_NAME'}) =~ s|^/?|/|;  ($scriptname = $ENV{'SCRIPT_NAME'}) =~ s|^/?|/|;
 $scriptname =~ s|/$||;  $scriptname =~ s|/$||;
 $scriptwhere = $scriptname . '/' . $where;  $scriptwhere = $scriptname . '/' . $where;
 $scriptwhere =~ s|/$||;  $scriptwhere =~ s|/$||;
   
 if (!-d $cvsroot) {  if ($query = $ENV{'QUERY_STRING'}) {
         &fatal("500 Internal Error",'$CVSROOT not found!');      foreach (split(/&/, $query)) {
 }  
   
 if ($q = $ENV{'QUERY_STRING'}) {  
     foreach (split(/&/, $q)) {  
         s/%(..)/sprintf("%c", hex($1))/ge;      # unquote %-quoted          s/%(..)/sprintf("%c", hex($1))/ge;      # unquote %-quoted
         if (/(\S+)=(.*)/) {          if (/(\S+)=(.*)/) {
             $input{$1} = $2;              $input{$1} = $2;
Line 79  if ($q = $ENV{'QUERY_STRING'}) {
Line 94  if ($q = $ENV{'QUERY_STRING'}) {
             $input{$_}++;              $input{$_}++;
         }          }
     }      }
       $query = "?" . $query;
 }  }
   
   
   $config = '/usr/local/etc/cvsweb';
   do "$config" if -f $config;
   
   if ($input{'cvsroot'}) {
       if ($CVSROOT{$input{'cvsroot'}}) {
           $cvstree = $input{'cvsroot'};
           $cvsroot = $CVSROOT{"$cvstree"};
       }
   }
   do "$config-$cvstree" if -f "$config-$cvstree";
   
   $fullname = $cvsroot . '/' . $where;
   
   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.');
   }
   
   
   {
       local(@foo, $i);
       local($scriptname) = $ENV{'SCRIPT_NAME'};
       foreach (keys %CVSROOT) {
           if (-d $CVSROOT{$_}) {
               push(@foo, $_);
           }
       }
       if ($#foo > 1) {
           $intro .= "<p>\nThis script support the following CVS trees:\n";
           for($i = 0; $i <= $#foo; $i++) {
               $intro .= qq{<a href="$scriptname?cvsroot=$foo[$i]">} .
                   ($CVSROOTdescr{$foo[$i]} ?
                    $CVSROOTdescr{$foo[$i]} : $foo[$i]) . qq{</a>} .
                        ($i == $#foo  ? ".\n" : ",\n");
           }
       }
   }
   
   
 if (-d $fullname) {  if (-d $fullname) {
         opendir(DIR, $fullname) || &fatal("404 Not Found","$where: $!");          opendir(DIR, $fullname) || &fatal("404 Not Found","$where: $!");
         @dir = readdir(DIR);          @dir = readdir(DIR);
Line 91  if (-d $fullname) {
Line 147  if (-d $fullname) {
             print &html_header("/$where");              print &html_header("/$where");
             print $shortinstr;              print $shortinstr;
         }          }
         print "<p>Current directory: <b>/$where</b>\n";          print "<p>";
           print "Current CVS tree: <b>$cvstree</b><br>\n"
               if $cvstree ne $cvstreedefault;
           print "Current directory: <b>/$where</b>\n";
         print "<P><HR NOSHADE>\n";          print "<P><HR NOSHADE>\n";
         # Using <MENU> in this manner violates the HTML2.0 spec but          # Using <MENU> in this manner violates the HTML2.0 spec but
         # provides the results that I want in most browsers.  Another          # provides the results that I want in most browsers.  Another
         # case of layout spooging up HTML.          # case of layout spooging up HTML.
         print "<MENU>\n";          print "<MENU>\n";
         foreach (sort @dir) {          lookingforattic:
           for ($i = 0; $i <= $#dir; $i++) {
                   if ($dir[$i] eq "Attic") {
                           last lookingforattic;
                   }
           }
           $haveattic = 1 if ($i <= $#dir);
           if (!$input{"showattic"} && ($i <= $#dir) &&
                                   opendir(DIR, $fullname . "/Attic")) {
                   splice(@dir, $i, 1,
                           grep((s|^|Attic/|,!m|/\.|), readdir(DIR)));
                   closedir(DIR);
           }
           # Sort without the Attic/ pathname.
           foreach (sort {($c=$a)=~s|.*/||;($d=$b)=~s|.*/||;($c cmp $d)} @dir) {
             if ($_ eq '.') {              if ($_ eq '.') {
                 next;                  next;
             }              }
               if (s|^Attic/||) {
                   $attic = " (in the Attic)";
               } else {
                   $attic = "";
               }
             if ($_ eq '..') {              if ($_ eq '..') {
                 next if ($where eq '');                  next if ($where eq '');
                 ($updir = $scriptwhere) =~ s|[^/]+$||;                  ($updir = $scriptwhere) =~ s|[^/]+$||;
                 print "<IMG SRC=\"/icons/back.gif\"> ",                  print "<IMG SRC=\"/icons/back.gif\"> ",
                     &link("Previous Directory",$updir), "<BR>";                      &link("Previous Directory",$updir . $query), "<BR>";
 #               print "<IMG SRC=???> ",  #               print "<IMG SRC=???> ",
 #                   &link("Directory-wide diffs", $scriptwhere . '/*'), "<BR>";  #                   &link("Directory-wide diffs", $scriptwhere . '/*'), "<BR>";
             } elsif (-d $fullname . "/" . $_) {              } elsif (-d $fullname . "/" . $_) {
                 print "<IMG SRC=\"/icons/dir.gif\"> ",                  print "<IMG SRC=\"/icons/dir.gif\"> ",
                     &link($_ . "/", $scriptwhere . '/' . $_ . '/'), "<BR>";                      &link($_ . "/", $scriptwhere . '/' . $_ . '/' . $query),
                               $attic, "<BR>";
             } elsif (s/,v$//) {              } elsif (s/,v$//) {
 # TODO: add date/time?  How about sorting?  # TODO: add date/time?  How about sorting?
                 print "<IMG SRC=\"/icons/text.gif\"> ",                  print "<IMG SRC=\"/icons/text.gif\"> ",
                     &link($_, $scriptwhere . '/' . $_), "<BR>";                      &link($_, $scriptwhere . '/' .
                               ($attic ? "Attic/" : "") . $_ . $query),
                               $attic, "<BR>";
             }              }
         }          }
         print "</MENU>\n";          print "</MENU>\n";
           if ($input{"only_on_branch"}) {
               print "<HR><FORM METHOD=\"GET\" ACTION=\"${scriptwhere}\">\n";
               print "Currently showing only branch $input{'only_on_branch'}.\n";
               $input{"only_on_branch"}="";
               foreach $k (keys %input) {
                   print "<INPUT TYPE=hidden NAME=$k VALUE=$input{$k}>\n" if $input{$k};
               }
               print "<INPUT TYPE=SUBMIT VALUE=\"Show all branches\">\n";
               print "</FORM>\n";
           }
           $formwhere = $scriptwhere;
           $formwhere =~ s|Attic/?$|| if ($input{"showattic"});
           if ($haveattic) {
                   print "<HR><FORM METHOD=\"GET\" ACTION=\"${formwhere}\">\n";
                   $input{"showattic"}=!$input{"showattic"};
                   foreach $k (keys %input) {
                       print "<INPUT TYPE=hidden NAME=$k VALUE=$input{$k}>\n" if $input{$k};
                   }
                   print "<INPUT TYPE=SUBMIT VALUE=\"";
                   print ($input{"showattic"} ? "Show" : "Hide");
                   print " attic directories\">\n";
                   print "</FORM>\n";
           }
         print &html_footer;          print &html_footer;
         print "</BODY></HTML>\n";          print "</BODY></HTML>\n";
 } elsif (-f $fullname . ',v') {  } elsif (-f $fullname . ',v') {
Line 130  if (-d $fullname) {
Line 234  if (-d $fullname) {
                         $input{'r2'}, $input{'tr2'}, $input{'f'});                          $input{'r2'}, $input{'tr2'}, $input{'f'});
                 exit;                  exit;
         }          }
   print("going to dolog($fullname)\n") if ($verbose);
           &dolog($fullname);
   } elsif ($fullname =~ s/\.diff$// && -f $fullname . ",v" &&
                                   $input{'r1'} && $input{'r2'}) {
           # Allow diffs using the ".diff" extension
           # so that browsers that default to the URL
           # for a save filename don't save diff's as
           # e.g. foo.c
           &dodiff($fullname, $input{'r1'}, $input{'tr1'},
                   $input{'r2'}, $input{'tr2'}, $input{'f'});
           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.
           ($newplace = $scriptwhere) =~ s|/([^/]+)$|/Attic/$1|;
           &redirect($newplace);
           exit;
   } elsif (0 && (@files = &safeglob($fullname . ",v"))) {
           print "Content-type: text/plain\n\n";
           print "You matched the following files:\n";
           print join("\n", @files);
           # Find the tags from each file
           # Display a form offering diffs between said tags
   } else {
           # Assume it's a module name with a potential path following it.
           $xtra = $& if (($module = $where) =~ s|/.*||);
           # Is there an indexed version of modules?
           if (open(MODULES, "$cvsroot/CVSROOT/modules")) {
                   while (<MODULES>) {
                           if (/^(\S+)\s+(\S+)/o && $module eq $1
                                   && -d "${cvsroot}/$2" && $module ne $2) {
                                   &redirect($scriptname . '/' . $2 . $xtra);
                           }
                   }
           }
           &fatal("404 Not Found","$where: no such file or directory");
   }
   
   sub htmlify {
           local($string, $pr) = @_;
   
           $string =~ s/&/&amp;/g;
           $string =~ s/</&lt;/g;
           $string =~ s/>/&gt;/g;
   
           if ($pr) {
                   $string =~ s|\bpr(\W+[a-z]+/\W*)(\d+)|<A HREF=/cgi/query-pr.cgi?pr=$2>$&</A>|ig;
           }
   
           $string;
   }
   
   sub link {
           local($name, $where) = @_;
   
           "<A HREF=\"$where\">$name</A>\n";
   }
   
   sub revcmp {
           local($rev1, $rev2) = @_;
           local(@r1) = split(/\./, $rev1);
           local(@r2) = split(/\./, $rev2);
           local($a,$b);
   
           while (($a = shift(@r1)) && ($b = shift(@r2))) {
               if ($a != $b) {
                   return $a <=> $b;
               }
           }
           if (@r1) { return 1; }
           if (@r2) { return -1; }
           return 0;
   }
   
   sub fatal {
           local($errcode, $errmsg) = @_;
           print "Status: $errcode\n";
           print &html_header("Error");
   #       print "Content-type: text/html\n";
   #       print "\n";
   #       print "<HTML><HEAD><TITLE>Error</TITLE></HEAD>\n";
   #       print "<BODY>Error: $errmsg</BODY></HTML>\n";
           print "Error: $errmsg\n";
           print &html_footer;
           exit(1);
   }
   
   sub redirect {
           local($url) = @_;
           print "Status: 301 Moved\n";
           print "Location: $url\n";
           print &html_header("Moved");
   #       print "Content-type: text/html\n";
   #       print "\n";
   #       print "<HTML><HEAD><TITLE>Moved</TITLE></HEAD>\n";
   #       print "<BODY>This document is located <A HREF=$url>here</A>.</BODY></HTML>\n";
           print "This document is located <A HREF=$url>here</A>.\n";
           print &html_footer;
           exit(1);
   }
   
   sub safeglob {
           local($filename) = @_;
           local($dirname);
           local(@results);
   
           ($dirname = $filename) =~ s|/[^/]+$||;
           $filename =~ s|.*/||;
   
           if (opendir(DIR, $dirname)) {
                   $glob = $filename;
           #       transform filename from glob to regex.  Deal with:
           #       [, {, ?, * as glob chars
           #       make sure to escape all other regex chars
                   $glob =~ s/([\.\(\)\|\+])/\\$1/g;
                   $glob =~ s/\*/.*/g;
                   $glob =~ s/\?/./g;
                   $glob =~ s/{([^}]+)}/($t = $1) =~ s-,-|-g; "($t)"/eg;
                   foreach (readdir(DIR)) {
                           if (/^${glob}$/) {
                                   push(@results, $dirname . "/" .$_);
                           }
                   }
           }
   
           @results;
   }
   
   sub checkout {
           local($fullname, $rev) = @_;
   
           open(RCS, "co -p$rev '$fullname' 2>&1 |") ||
               &fail("500 Internal Error", "Couldn't co: $!");
   # /home/ncvs/src/sys/netinet/igmp.c,v  -->  standard output
   # or
   # /home/ncvs/src/sys/netinet/igmp.c,v  -->  stdout
   # revision 1.1.1.2
   # /*
           $_ = <RCS>;
           if (/^(\S+),v\s+-->\s+st(andar)?d ?out(put)?\s*$/o && $1 eq $fullname) {
               # As expected
           } else {
               &fatal("500 Internal Error",
                   "Unexpected output from co: $_");
           }
           $_ = <RCS>;
           if (/^revision\s+$rev\s*$/) {
               # As expected
           } else {
               &fatal("500 Internal Error",
                   "Unexpected output from co: $_");
           }
           $| = 1;
           print "Content-type: text/plain\n\n";
           print <RCS>;
           close(RCS);
   }
   
   sub dodiff {
           local($fullname, $r1, $tr1, $r2, $tr2, $f) = @_;
   
           if ($r1 =~ /([^:]+)(:(.+))?/) {
               $rev1 = $1;
               $sym1 = $3;
           }
           if ($rev1 eq 'text') {
               $rev1 = $tr1;
           }
           if ($r2 =~ /([^:]+)(:(.+))?/) {
               $rev2 = $1;
               $sym2 = $3;
           }
           if ($rev2 eq 'text') {
               $rev2 = $tr2;
           }
           if (!($rev1 =~ /^[\d\.]+$/) || !($rev2 =~ /^[\d\.]+$/)) {
               &fatal("404 Not Found",
                       "Malformed query \"$ENV{'QUERY_STRING'}\"");
           }
   #
   # 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) {
               ($tmp1, $tmp2) = ($rev1, $sym1);
               ($rev1, $sym1) = ($rev2, $sym2);
               ($rev2, $sym2) = ($tmp1, $tmp2);
           }
   #
   #       XXX Putting '-p' here is a personal preference
           if ($f eq 'c') {
               $difftype = '-p -c';
               $diffname = "Context diff";
           } elsif ($f eq 's') {
               $difftype = '--side-by-side --width=164';
               $diffname = "Side by Side";
           } else {
               $difftype = '-p -u';
               $diffname = "Unidiff";
           }
   # XXX should this just be text/plain
   # or should it have an HTML header and then a <pre>
           print "Content-type: text/plain\n\n";
           open(RCSDIFF, "rcsdiff $difftype -r$rev1 -r$rev2 '$fullname' 2>&1 |") ||
               &fail("500 Internal Error", "Couldn't rcsdiff: $!");
   #
   #===================================================================
   #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 ($difftype eq '-u') {
               $f1 = '---';
               $f2 = '\+\+\+';
           } else {
               $f1 = '\*\*\*';
               $f2 = '---';
           }
           while (<RCSDIFF>) {
               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(RCSDIFF);
   }
   
   sub dolog {
           local($fullname) = @_;
           local($curbranch,$symnames);    #...
   
           print("Going to rlog '$fullname'\n") if ($verbose);
         open(RCS, "rlog '$fullname'|") || &fatal("500 Internal Error",          open(RCS, "rlog '$fullname'|") || &fatal("500 Internal Error",
                                                 "Failed to spawn rlog");                                                  "Failed to spawn rlog");
         while (<RCS>) {          while (<RCS>) {
Line 168  if (-d $fullname) {
Line 526  if (-d $fullname) {
         logentry:          logentry:
         while (!/^=========/) {          while (!/^=========/) {
             $_ = <RCS>;              $_ = <RCS>;
               last logentry if (!defined($_));    # EOF
             print "R:", $_ if ($verbose);              print "R:", $_ if ($verbose);
             if (/^revision ([\d\.]+)/) {              if (/^revision ([\d\.]+)/) {
                 $rev = $1;                  $rev = $1;
             } elsif (/^========/ || /^----------------------------$/) {              } elsif (/^========/ || /^----------------------------$/) {
                 next logentry;                  next logentry;
             } else {              } else {
                 &fatal("500 Internal Error","Error parsing RCS output: $_");                  # The rlog output is syntactically ambiguous.  We must
                   # have guessed wrong about where the end of the last log
                   # message was.
                   # Since this is likely to happen when people put rlog output
                   # in their commit messages, don't even bother keeping
                   # these lines since we don't know what revision they go with
                   # any more.
                   next logentry;
   #               &fatal("500 Internal Error","Error parsing RCS output: $_");
             }              }
             $_ = <RCS>;              $_ = <RCS>;
             print "D:", $_ if ($verbose);              print "D:", $_ if ($verbose);
             if (m|^date:\s+(\d+)/(\d+)/(\d+)\s+(\d+):(\d+):(\d+);\s+author:\s+(\S+);|) {              if (m|^date:\s+(\d+)/(\d+)/(\d+)\s+(\d+):(\d+):(\d+);\s+author:\s+(\S+);\s+state:\s+(\S+);|) {
                 $yr = $1;                  $yr = $1;
                 # damn 2-digit year routines                  # damn 2-digit year routines
                 if ($yr > 100) {                  if ($yr > 100) {
Line 186  if (-d $fullname) {
Line 553  if (-d $fullname) {
                 }                  }
                 $date{$rev} = &timelocal($6,$5,$4,$3,$2 - 1,$yr);                  $date{$rev} = &timelocal($6,$5,$4,$3,$2 - 1,$yr);
                 $author{$rev} = $7;                  $author{$rev} = $7;
                   $state{$rev} = $8;
             } else {              } else {
                 &fatal("500 Internal Error", "Error parsing RCS output: $_");                  &fatal("500 Internal Error", "Error parsing RCS output: $_");
             }              }
Line 266  if (-d $fullname) {
Line 634  if (-d $fullname) {
         }          }
         print "Done associating revisions with branches\n" if ($verbose);          print "Done associating revisions with branches\n" if ($verbose);
         print &html_header("CVS log for $where");          print &html_header("CVS log for $where");
         ($upwhere = $where) =~ s|[^/]+$||;          ($upwhere = $where) =~ s|(Attic/)?[^/]+$||;
         print "Up to ", &link($upwhere,$scriptname . "/" . $upwhere);          print "Up to ", &link($upwhere,$scriptname . "/" . $upwhere . $query);
         print "<BR>\n";          print "<BR>\n";
         print "<A HREF=\"#diff\">Request diff between arbitrary revisions</A>\n";          print "<A HREF=\"#diff\">Request diff between arbitrary revisions</A>\n";
         print "<HR NOSHADE>\n";          print "<HR NOSHADE>\n";
Line 301  if (-d $fullname) {
Line 669  if (-d $fullname) {
                 $nameprinted{$br}++;                  $nameprinted{$br}++;
             }              }
             print "\n";              print "\n";
             print "<A HREF=\"$scriptwhere?rev=$_\"><b>$_</b></A>";              print "<A HREF=\"$scriptwhere?rev=$_" .
                   &cvsroot . "\"><b>$_</b></A>";
             if (/^1\.1\.1\.\d+$/) {              if (/^1\.1\.1\.\d+$/) {
                 print " <i>(vendor branch)</i>";                  print " <i>(vendor branch)</i>";
             }              }
             print " <i>" . &ctime($date{$_}) . "</i> by ";              print " <i>" . &ctime($date{$_}) . " UTC</i> by ";
             print "<i>" . $author{$_} . "</i>\n";              print "<i>" . $author{$_} . "</i>\n";
             if ($revsym{$_}) {              if ($revsym{$_}) {
                 print "<BR>CVS Tags: <b>$revsym{$_}</b>";                  print "<BR>CVS Tags: <b>$revsym{$_}</b>";
Line 344  if (-d $fullname) {
Line 713  if (-d $fullname) {
             if ($prevrev[$#prevrev] != 0) {              if ($prevrev[$#prevrev] != 0) {
                 $prev = join(".", @prevrev);                  $prev = join(".", @prevrev);
                 print "<BR><A HREF=\"${scriptwhere}.diff?r1=$prev";                  print "<BR><A HREF=\"${scriptwhere}.diff?r1=$prev";
                 print "&r2=$_\">Diffs to $prev</A>\n";                  print "&r2=$_" . &cvsroot . "\">Diffs to $prev</A>\n";
                 #                  #
                 # Plus, if it's on a branch, and it's not a vendor branch,                  # Plus, if it's on a branch, and it's not a vendor branch,
                 # offer to diff with the immediately-preceding commit if it                  # offer to diff with the immediately-preceding commit if it
Line 358  if (-d $fullname) {
Line 727  if (-d $fullname) {
                     @tmp2 = split(/\./, $_);                      @tmp2 = split(/\./, $_);
                     if ($#tmp1 < $#tmp2) {                      if ($#tmp1 < $#tmp2) {
                         print "; <A HREF=\"${scriptwhere}.diff?r1=$revorder[$i+1]";                          print "; <A HREF=\"${scriptwhere}.diff?r1=$revorder[$i+1]";
                         print "&r2=$_\">Diffs to $revorder[$i+1]</A>\n";                          print "&r2=$_" . &cvsroot .
                               "\">Diffs to $revorder[$i+1]</A>\n";
                     }                      }
                 }                  }
             }              }
               if ($state{$_} eq "dead") {
                   print "<BR><B><I>FILE REMOVED</I></B>\n";
               }
             print "<PRE>\n";              print "<PRE>\n";
             print &htmlify($log{$_}, 1);              print &htmlify($log{$_}, 1);
             print "</PRE><HR NOSHADE>\n";              print "</PRE><HR NOSHADE>\n";
Line 373  if (-d $fullname) {
Line 746  if (-d $fullname) {
         print "name using the type-in text box.\n";          print "name using the type-in text box.\n";
         print "</A><P>\n";          print "</A><P>\n";
         print "<FORM METHOD=\"GET\" ACTION=\"${scriptwhere}.diff\">\n";          print "<FORM METHOD=\"GET\" ACTION=\"${scriptwhere}.diff\">\n";
           print "<INPUT TYPE=HIDDEN NAME=\"cvsroot\" VALUE=\"$cvstree\">\n"
                if &cvsroot;
         print "Diffs between \n";          print "Diffs between \n";
         print "<SELECT NAME=\"r1\">\n";          print "<SELECT NAME=\"r1\">\n";
         print "<OPTION VALUE=\"text\" SELECTED>Use Text Field\n";          print "<OPTION VALUE=\"text\" SELECTED>Use Text Field\n";
Line 396  if (-d $fullname) {
Line 771  if (-d $fullname) {
         print "a single branch.\n";          print "a single branch.\n";
         print "</A><P>\n";          print "</A><P>\n";
         print "<FORM METHOD=\"GET\" ACTION=\"$scriptwhere\">\n";          print "<FORM METHOD=\"GET\" ACTION=\"$scriptwhere\">\n";
           print qq{<input type=hidden name=cvsroot value=$cvstree>\n}
                if &cvsroot;
         print "Branch: \n";          print "Branch: \n";
         print "<SELECT NAME=\"only_on_branch\">\n";          print "<SELECT NAME=\"only_on_branch\">\n";
           print "<OPTION VALUE=\"\"";
           print " SELECTED" if ($input{"only_on_branch"} eq "");
           print ">Show all branches\n";
         foreach (sort @branchnames) {          foreach (sort @branchnames) {
                 print "<OPTION>${_}\n";                  print "<OPTION";
                   print " SELECTED" if ($input{"only_on_branch"} eq $_);
                   print ">${_}\n";
         }          }
         print "</SELECT>\n";          print "</SELECT>\n";
         print "<INPUT TYPE=SUBMIT VALUE=\"View Branch\">\n";          print "<INPUT TYPE=SUBMIT VALUE=\"View Branch\">\n";
         print "</FORM>\n";          print "</FORM>\n";
         print &html_footer;          print &html_footer;
         print "</BODY></HTML>\n";          print "</BODY></HTML>\n";
 } elsif ($fullname =~ s/\.diff$// && -f $fullname . ",v" &&  
                                 $input{'r1'} && $input{'r2'}) {  
         &dodiff($fullname, $input{'r1'}, $input{'tr1'},  
                 $input{'r2'}, $input{'tr2'}, $input{'f'});  
         exit;  
 } elsif (0 && (@files = &safeglob($fullname . ",v"))) {  
         print "Content-type: text/plain\n\n";  
         print "You matched the following files:\n";  
         print join("\n", @files);  
         # Find the tags from each file  
         # Display a form offering diffs between said tags  
 } else {  
         # Assume it's a module name with a potential path following it.  
         ($module = $where) =~ s|/.*||;  
         $xtra = $&;  
         # Is there an indexed version of modules?  
         if (open(MODULES, "$cvsroot/CVSROOT/modules")) {  
                 while (<MODULES>) {  
                         if (/^(\S+)\s+(\S+)/o && $module eq $1  
                                 && -d "${cvsroot}/$2" && $module ne $2) {  
                                 &redirect($scriptname . '/' . $2 . $xtra);  
                         }  
                 }  
         }  
         &fatal("404 Not Found","$where: no such file or directory");  
 }  }
   
 sub htmlify {  sub cvsroot {
         local($string, $pr) = @_;      return '' if $cvstree eq $cvstreedefault;
       return "&cvsroot=" . $cvstree;
         $string =~ s/&/&amp;/g;  
         $string =~ s/</&lt;/g;  
         $string =~ s/>/&gt;/g;  
   
         if ($pr) {  
                 $string =~ s|\bpr(\W+[a-z]+/\W*)(\d+)|<A HREF=/cgi/query-pr.cgi?pr=$2>$&</A>|ig;  
         }  
   
         $string;  
 }  
   
 sub link {  
         local($name, $where) = @_;  
   
         "<A HREF=\"$where\">$name</A>\n";  
 }  
   
 sub revcmp {  
         local($rev1, $rev2) = @_;  
         local(@r1) = split(/\./, $rev1);  
         local(@r2) = split(/\./, $rev2);  
         local($a,$b);  
   
         while (($a = shift(@r1)) && ($b = shift(@r2))) {  
             if ($a != $b) {  
                 return $a <=> $b;  
             }  
         }  
         if (@r1) { return 1; }  
         if (@r2) { return -1; }  
         return 0;  
 }  
   
 sub fatal {  
         local($errcode, $errmsg) = @_;  
         print "Status: $errcode\n";  
         print &html_header("Error");  
 #       print "Content-type: text/html\n";  
 #       print "\n";  
 #       print "<HTML><HEAD><TITLE>Error</TITLE></HEAD>\n";  
 #       print "<BODY>Error: $errmsg</BODY></HTML>\n";  
         print "Error: $errmsg\n";  
         print &html_footer;  
         exit(1);  
 }  
   
 sub redirect {  
         local($url) = @_;  
         print "Status: 301 Moved\n";  
         print "Location: $url\n";  
         print &html_header("Moved");  
 #       print "Content-type: text/html\n";  
 #       print "\n";  
 #       print "<HTML><HEAD><TITLE>Moved</TITLE></HEAD>\n";  
 #       print "<BODY>This document is located <A HREF=$url>here</A>.</BODY></HTML>\n";  
         print "This document is located <A HREF=$url>here</A>.\n";  
         print &html_footer;  
         exit(1);  
 }  
   
 sub safeglob {  
         local($filename) = @_;  
         local($dirname);  
         local(@results);  
   
         ($dirname = $filename) =~ s|/[^/]+$||;  
         $filename =~ s|.*/||;  
   
         if (opendir(DIR, $dirname)) {  
                 $glob = $filename;  
         #       transform filename from glob to regex.  Deal with:  
         #       [, {, ?, * as glob chars  
         #       make sure to escape all other regex chars  
                 $glob =~ s/([\.\(\)\|\+])/\\$1/g;  
                 $glob =~ s/\*/.*/g;  
                 $glob =~ s/\?/./g;  
                 $glob =~ s/{([^}]+)}/($t = $1) =~ s-,-|-g; "($t)"/eg;  
                 foreach (readdir(DIR)) {  
                         if (/^${glob}$/) {  
                                 push(@results, $dirname . "/" .$_);  
                         }  
                 }  
         }  
   
         @results;  
 }  
   
 sub checkout {  
         local($fullname, $rev) = @_;  
   
         open(RCS, "co -p$rev '$fullname' 2>&1 |") ||  
             &fail("500 Internal Error", "Couldn't co: $!");  
 # /home/ncvs/src/sys/netinet/igmp.c,v  -->  standard output  
 # or  
 # /home/ncvs/src/sys/netinet/igmp.c,v  -->  stdout  
 # revision 1.1.1.2  
 # /*  
         $_ = <RCS>;  
         if (/^(\S+),v\s+-->\s+st(andar)?d ?out(put)?\s*$/o && $1 eq $fullname) {  
             # As expected  
         } else {  
             &fatal("500 Internal Error",  
                 "Unexpected output from co: $_");  
         }  
         $_ = <RCS>;  
         if (/^revision\s+$rev\s*$/) {  
             # As expected  
         } else {  
             &fatal("500 Internal Error",  
                 "Unexpected output from co: $_");  
         }  
         $| = 1;  
         print "Content-type: text/plain\n\n";  
         print <RCS>;  
         close(RCS);  
 }  
   
 sub dodiff {  
         local($fullname, $r1, $tr1, $r2, $tr2, $f) = @_;  
   
         if ($r1 =~ /([^:]+)(:(.+))?/) {  
             $rev1 = $1;  
             $sym1 = $3;  
         }  
         if ($rev1 eq 'text') {  
             $rev1 = $tr1;  
         }  
         if ($r2 =~ /([^:]+)(:(.+))?/) {  
             $rev2 = $1;  
             $sym2 = $3;  
         }  
         if ($rev2 eq 'text') {  
             $rev2 = $tr2;  
         }  
         if (!($rev1 =~ /^[\d\.]+$/) || !($rev2 =~ /^[\d\.]+$/)) {  
             &fatal("404 Not Found",  
                     "Malformed query \"$ENV{'QUERY_STRING'}\"");  
         }  
 #  
 # 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) {  
             ($tmp1, $tmp2) = ($rev1, $sym1);  
             ($rev1, $sym1) = ($rev2, $sym2);  
             ($rev2, $sym2) = ($tmp1, $tmp2);  
         }  
 #  
 #       XXX Putting '-p' here is a personal preference  
         if ($f eq 'c') {  
             $difftype = '-p -c';  
             $diffname = "Context diff";  
         } elsif ($f eq 's') {  
             $difftype = '--side-by-side --width=164';  
             $diffname = "Side by Side";  
         } else {  
             $difftype = '-p -u';  
             $diffname = "Unidiff";  
         }  
 # XXX should this just be text/plain  
 # or should it have an HTML header and then a <pre>  
         print "Content-type: text/plain\n\n";  
         open(RCSDIFF, "rcsdiff $difftype -r$rev1 -r$rev2 '$fullname' 2>&1 |") ||  
             &fail("500 Internal Error", "Couldn't rcsdiff: $!");  
 #  
 #===================================================================  
 #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 ($difftype eq '-u') {  
             $f1 = '---';  
             $f2 = '\+\+\+';  
         } else {  
             $f1 = '\*\*\*';  
             $f2 = '---';  
         }  
         while (<RCSDIFF>) {  
             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(RCSDIFF);  
 }  }
Legend:
Removed from v.1.8  
changed lines
  Added in v.1.17
CVSweb