Annotation of cvsweb/cvsweb.cgi, Revision 1.1
1.1 ! jfieber 1: #!/usr/bin/perl -s
! 2: #
! 3: # cvsweb - a CGI interface to the CVS tree.
! 4: #
! 5: # Written by Bill Fenner <fenner@parc.xerox.com> on his own time.
! 6: # Insert BSD copyright here.
! 7: #
! 8: #HTTP_USER_AGENT: Mozilla/1.1N (X11; I; SunOS 4.1.3_U1 sun4m) via proxy gateway CERN-HTTPD/3.0 libwww/2.17
! 9: #SERVER_NAME: www.freebsd.org
! 10: #QUERY_STRING: baz
! 11: #SCRIPT_FILENAME: /usr/local/www/cgi-bin/env.pl
! 12: #SERVER_PORT: 80
! 13: #HTTP_ACCEPT: */*, image/gif, image/x-xbitmap, image/jpeg
! 14: #SERVER_PROTOCOL: HTTP/1.0
! 15: #HTTP_COOKIE: s=beta26429821397802167
! 16: #PATH_INFO: /foo/bar
! 17: #REMOTE_ADDR: 13.1.64.94
! 18: #DOCUMENT_ROOT: /usr/local/www/data/
! 19: #PATH: /sbin:/bin:/usr/sbin:/usr/bin
! 20: #PATH_TRANSLATED: /usr/local/www/data//foo/bar
! 21: #GATEWAY_INTERFACE: CGI/1.1
! 22: #REQUEST_METHOD: GET
! 23: #SCRIPT_NAME: /cgi-bin/env.pl
! 24: #SERVER_SOFTWARE: Apache/1.0.0
! 25: #REMOTE_HOST: beta.xerox.com
! 26: #SERVER_ADMIN: webmaster@freebsd.org
! 27: #
! 28: require 'timelocal.pl';
! 29: require 'ctime.pl';
! 30:
! 31: $cvsroot = '/home/ncvs';
! 32: $intro = "
! 33: This is a WWW interface to the FreeBSD CVS tree.
! 34: You can browse the file hierarchy by picking directories
! 35: (which have slashes after them, e.g. <b>src/</b>).
! 36: If you pick a file, you will see the revision history
! 37: for that file.
! 38: Selecting a revision number will download that revision of
! 39: the file. There is a link at each revision to display
! 40: diffs between that revision and the previous one, and
! 41: a form at the bottom of the page that allows you to
! 42: display diffs between arbitrary revisions.
! 43: <p>
! 44: Please send any suggestions, comments, etc. to
! 45: <A HREF=\"mailto:fenner@freebsd.org\">Bill Fenner <fenner@freebsd.org></A>
! 46: ";
! 47: $shortinstr = "
! 48: Click on a directory to enter that directory. Click on a file to display
! 49: its revision history and to get a
! 50: chance to display diffs between revisions.
! 51: ";
! 52:
! 53: $verbose = $v;
! 54: ($where = $ENV{'PATH_INFO'}) =~ s|^/||;
! 55: $where =~ s|/$||;
! 56: $fullname = $cvsroot . '/' . $where;
! 57: ($scriptname = $ENV{'SCRIPT_NAME'}) =~ s|^/?|/|;
! 58: $scriptname =~ s|/$||;
! 59: $scriptwhere = $scriptname . '/' . $where;
! 60: $scriptwhere =~ s|/$||;
! 61:
! 62: if (!-d $cvsroot) {
! 63: &fatal("500 Internal Error",'$CVSROOT not found!');
! 64: }
! 65: if (-d $fullname) {
! 66: # Something that would be nice to support, although I have no real
! 67: # good idea of how, would be to get full directory diff's, using
! 68: # symbolic names (revision numbers would be meaningless).
! 69: # The problem is finding a list of symbolic names that is common
! 70: # to all the files in the directory.
! 71: #
! 72: opendir(DIR, $fullname) || &fatal("404 Not Found","$where: $!");
! 73: @dir = readdir(DIR);
! 74: closedir(DIR);
! 75: print "Content-type: text/html\n\n";
! 76: print "<HTML><HEAD><TITLE>FreeBSD CVS Tree: /$where</TITLE></HEAD>\n";
! 77: print "<BODY>\n";
! 78: print "<h1><img src=\"/gifs/biglogo.gif\" alt=\"\"> ";
! 79: print "FreeBSD CVS Tree</h1>\n<hr>\n";
! 80: # print "<!-- I wish there was a \"halign=center\" for IMG... -->\n";
! 81: # print "<center>\n";
! 82: # print "<IMG SRC=\"/gifs/daemonbar.gif\" alt=\"\">\n";
! 83: # print "</center>\n";
! 84: # print "<H1 align=center>FreeBSD CVS Tree</H1>\n";
! 85: if ($where eq '') {
! 86: print $intro;
! 87: } else {
! 88: print $shortinstr;
! 89: }
! 90: print "<p>Current directory: <b>/$where</b>\n";
! 91: print "<P><HR>\n";
! 92: # Using <MENU> in this manner violates the HTML2.0 spec but
! 93: # provides the results that I want in most browsers. Another
! 94: # case of layout spooging up HTML.
! 95: print "<MENU>\n";
! 96: foreach (sort @dir) {
! 97: if ($_ eq '.') {
! 98: next;
! 99: }
! 100: if ($_ eq '..') {
! 101: next if ($where eq '');
! 102: ($updir = $scriptwhere) =~ s|[^/]+$||;
! 103: print "<IMG SRC=\"/icons/back.gif\"> ",
! 104: &link("Previous Directory",$updir), "<BR>";
! 105: } elsif (-d $fullname . "/" . $_) {
! 106: print "<IMG SRC=\"/icons/dir.gif\"> ",
! 107: &link($_ . "/", $scriptwhere . '/' . $_ . '/'), "<BR>";
! 108: } elsif (s/,v$//) {
! 109: print "<IMG SRC=\"/icons/text.gif\"> ",
! 110: &link($_, $scriptwhere . '/' . $_), "<BR>";
! 111: }
! 112: }
! 113: print "</MENU>\n";
! 114: print "<hr>
! 115: <a href=\"/\"><img src=\"/gifs/home.gif\" alt=\"FreeBSD Home
! 116: Page\" border=\"0\" align=\"right\"></a>
! 117: <address>
! 118: <a href=\"/mailto.html\">www@freebsd.org</a>
! 119: </address>\n";
! 120: # print "<HR>\n";
! 121: # print "<A HREF=\"/\"><IMG SRC=\"/gifs/home.gif\" ALT=\"FreeBSD Home Page\">\n";
! 122: # print "</A>\n";
! 123: print "</BODY></HTML>\n";
! 124: } elsif (-f $fullname . ',v') {
! 125: if ($_ = $ENV{'QUERY_STRING'}) {
! 126: s/%(..)/sprintf("%c", hex($1))/ge; # unquote %-quoted
! 127: if (/rev=([\d\.]+)/) {
! 128: $rev = $1;
! 129: open(RCS, "co -p$rev '$fullname' 2>&1 |") ||
! 130: &fail("500 Internal Error", "Couldn't co: $!");
! 131: # /home/ncvs/src/sys/netinet/igmp.c,v --> standard output
! 132: # revision 1.1.1.2
! 133: # /*
! 134: $_ = <RCS>;
! 135: if (/^$fullname,v\s+-->\s+standard output\s*$/o) {
! 136: # As expected
! 137: } else {
! 138: &fatal("500 Internal Error",
! 139: "Unexpected output from co: $_");
! 140: }
! 141: $_ = <RCS>;
! 142: if (/^revision\s+$rev\s*$/) {
! 143: # As expected
! 144: } else {
! 145: &fatal("500 Internal Error",
! 146: "Unexpected output from co: $_");
! 147: }
! 148: $| = 1;
! 149: print "Content-type: text/plain\n";
! 150: print "Content-encoding: x-gzip\n\n";
! 151: open(GZIP, "|gzip -1 -c"); # need lightweight compression
! 152: print GZIP <RCS>;
! 153: close(GZIP);
! 154: close(RCS);
! 155: exit;
! 156: }
! 157: if (/r1=([^&:]+)(:([^&]+))?/) {
! 158: $rev1 = $1;
! 159: $sym1 = $3;
! 160: }
! 161: if ($rev1 eq 'text') {
! 162: if (/tr1=([^&]+)/) {
! 163: $rev1 = $1;
! 164: }
! 165: }
! 166: if (/r2=([^&:]+)(:([^&]+))?/) {
! 167: $rev2 = $1;
! 168: $sym2 = $3;
! 169: }
! 170: if ($rev2 eq 'text') {
! 171: if (/tr2=([^&]+)/) {
! 172: $rev2 = $1;
! 173: }
! 174: }
! 175: if (!($rev1 =~ /^[\d\.]+$/) || !($rev2 =~ /^[\d\.]+$/)) {
! 176: &fatal("404 Not Found",
! 177: "Malformed query \"$ENV{'QUERY_STRING'}\"");
! 178: }
! 179: #
! 180: # rev1 and rev2 are now both numeric revisions.
! 181: # Thus we do a DWIM here and swap them if rev1 is after rev2.
! 182: # XXX should we warn about the fact that we do this?
! 183: if (&revcmp($rev1,$rev2) > 0) {
! 184: ($tmp1, $tmp2) = ($rev1, $sym1);
! 185: ($rev1, $sym1) = ($rev2, $sym2);
! 186: ($rev2, $sym2) = ($tmp1, $tmp2);
! 187: }
! 188: #
! 189: $difftype = "-u";
! 190: $diffname = "Unidiff";
! 191: if (/f=([^&]+)/) {
! 192: if ($1 eq 'c') {
! 193: $difftype = '-c';
! 194: $diffname = "Context diff";
! 195: }
! 196: }
! 197: # XXX should this just be text/plain
! 198: # or should it have an HTML header and then a <pre>
! 199: print "Content-type: text/plain\n\n";
! 200: open(RCSDIFF, "rcsdiff $difftype -r$rev1 -r$rev2 '$fullname' 2>&1 |") ||
! 201: &fail("500 Internal Error", "Couldn't rcsdiff: $!");
! 202: #
! 203: #===================================================================
! 204: #RCS file: /home/ncvs/src/sys/netinet/tcp_output.c,v
! 205: #retrieving revision 1.16
! 206: #retrieving revision 1.17
! 207: #diff -c -r1.16 -r1.17
! 208: #*** /home/ncvs/src/sys/netinet/tcp_output.c 1995/11/03 22:08:08 1.16
! 209: #--- /home/ncvs/src/sys/netinet/tcp_output.c 1995/12/05 17:46:35 1.17
! 210: #
! 211: # Ideas:
! 212: # - nuke the stderr output if it's what we expect it to be
! 213: # - Add "no differences found" if the diff command supplied no output.
! 214: #
! 215: #*** src/sys/netinet/tcp_output.c 1995/11/03 22:08:08 1.16
! 216: #--- src/sys/netinet/tcp_output.c 1995/12/05 17:46:35 1.17 RELENG_2_1_0
! 217: # (bogus example, but...)
! 218: #
! 219: if ($difftype eq '-u') {
! 220: $f1 = '---';
! 221: $f2 = '\+\+\+';
! 222: } else {
! 223: $f1 = '\*\*\*';
! 224: $f2 = '---';
! 225: }
! 226: while (<RCSDIFF>) {
! 227: if (m|^$f1 $cvsroot|o) {
! 228: s|$cvsroot/||o;
! 229: if ($sym1) {
! 230: chop;
! 231: $_ .= " " . $sym1 . "\n";
! 232: }
! 233: } elsif (m|^$f2 $cvsroot|o) {
! 234: s|$cvsroot/||o;
! 235: if ($sym2) {
! 236: chop;
! 237: $_ .= " " . $sym2 . "\n";
! 238: }
! 239: }
! 240: print $_;
! 241: }
! 242: close(RCSDIFF);
! 243: exit;
! 244: }
! 245: open(RCS, "rlog '$fullname'|") || &fatal("500 Internal Error",
! 246: "Failed to spawn rlog");
! 247: while (<RCS>) {
! 248: print if ($verbose);
! 249: if ($symnames) {
! 250: if (/^\s+([^:]+):\s+([\d\.]+)/) {
! 251: $symrev{$1} = $2;
! 252: if ($revsym{$2}) {
! 253: $revsym{$2} .= ", ";
! 254: }
! 255: $revsym{$2} .= $1;
! 256: } else {
! 257: $symnames = 0;
! 258: }
! 259: } elsif (/^symbolic names/) {
! 260: $symnames = 1;
! 261: } elsif (/^-----/) {
! 262: last;
! 263: }
! 264: }
! 265: # each log entry is of the form:
! 266: # ----------------------------
! 267: # revision 3.7.1.1
! 268: # date: 1995/11/29 22:15:52; author: fenner; state: Exp; lines: +5 -3
! 269: # log info
! 270: # ----------------------------
! 271: logentry:
! 272: while (!/^=========/) {
! 273: $_ = <RCS>;
! 274: print "R:", $_ if ($verbose);
! 275: if (/^revision ([\d\.]+)/) {
! 276: $rev = $1;
! 277: } elsif (/^========/ || /^----------------------------$/) {
! 278: next logentry;
! 279: } else {
! 280: &fatal("500 Internal Error","Error parsing RCS output: $_");
! 281: }
! 282: $_ = <RCS>;
! 283: print "D:", $_ if ($verbose);
! 284: if (m|^date:\s+(\d+)/(\d+)/(\d+)\s+(\d+):(\d+):(\d+);\s+author:\s+(\S+);|) {
! 285: $yr = $1;
! 286: # damn 2-digit year routines
! 287: if ($yr > 100) {
! 288: $yr -= 1900;
! 289: }
! 290: $date{$rev} = &timelocal($6,$5,$4,$3,$2 - 1,$yr);
! 291: $author{$rev} = $7;
! 292: } else {
! 293: &fatal("500 Internal Error", "Error parsing RCS output: $_");
! 294: }
! 295: line:
! 296: while (<RCS>) {
! 297: print "L:", $_ if ($verbose);
! 298: next line if (/^branches:\s/);
! 299: last line if (/^----------------------------$/ || /^=========/);
! 300: $log{$rev} .= $_;
! 301: }
! 302: print "E:", $_ if ($verbose);
! 303: }
! 304: close(RCS);
! 305: print "Done reading RCS file\n" if ($verbose);
! 306: #
! 307: # Sort the revisions into commit-date order.
! 308: @revorder = sort {$date{$b} <=> $date{$a}} keys %date;
! 309: print "Done sorting revisions\n" if ($verbose);
! 310: #
! 311: # HEAD is an artificial tag which is simply the highest tag number on the main
! 312: # branch (I think!). Find it by looking through @revorder; it should at least
! 313: # be near the beginning (In fact, it *should* be the first commit listed on
! 314: # the main branch.)
! 315: revision:
! 316: for ($i = 0; $i <= $#revorder; $i++) {
! 317: if ($revorder[$i] =~ /^\d+\.\d+$/) {
! 318: if ($revsym{$revorder[$i]}) {
! 319: $revsym{$revorder[$i]} .= ", ";
! 320: }
! 321: $revsym{$revorder[$i]} .= "HEAD";
! 322: $symrev{"HEAD"} = $revorder[$i];
! 323: last revision;
! 324: }
! 325: }
! 326: print "Done finding HEAD\n" if ($verbose);
! 327: #
! 328: # Now that we know all of the revision numbers, we can associate
! 329: # absolute revision numbers with all of the symbolic names, and
! 330: # pass them to the form so that the same association doesn't have
! 331: # to be built then.
! 332: #
! 333: # should make this a case-insensitive sort
! 334: foreach (sort keys %symrev) {
! 335: $rev = $symrev{$_};
! 336: if ($rev =~ /^(\d+(\.\d+)+)\.0\.(\d+)$/) {
! 337: #
! 338: # A revision number of A.B.0.D really translates into
! 339: # "the highest current revision on branch A.B.D".
! 340: #
! 341: # If there is no branch A.B.D, then it translates into
! 342: # the head A.B .
! 343: #
! 344: # This is pure speculation.
! 345: #
! 346: $head = $1;
! 347: $branch = $3;
! 348: $regex = $head . "." . $branch;
! 349: $regex =~ s/\./\./g;
! 350: # <
! 351: # \____/
! 352: $rev = $head;
! 353:
! 354: revision:
! 355: foreach $r (@revorder) {
! 356: if ($r =~ /^${regex}/) {
! 357: $rev = $head . "." . $branch;
! 358: last revision;
! 359: }
! 360: }
! 361: $revsym{$rev} .= ", " if ($revsym{$rev});
! 362: $revsym{$rev} .= $_;
! 363: }
! 364: $sel .= "<OPTION VALUE=\"${rev}:${_}\">$_\n";
! 365: }
! 366: print "Done associating revisions with branches\n" if ($verbose);
! 367: print "Content-type: text/html\n\n";
! 368: print "<HTML><HEAD><TITLE>CVS log for $where</TITLE></HEAD>\n";
! 369: print "<BODY>\n";
! 370: print "<H1 align=center>CVS log for $where</H1>\n";
! 371: ($upwhere = $where) =~ s|[^/]+$||;
! 372: print "Up to ", &link($upwhere,$scriptname . "/" . $upwhere);
! 373: print "<BR>\n";
! 374: print "<A HREF=\"#diff\">Request diff between arbitrary revisions</A>\n";
! 375: print "<HR>\n";
! 376: # The other possible U.I. I can see is to have each revision be hot
! 377: # and have the first one you click do ?r1=foo
! 378: # and since there's no r2 it keeps going & the next one you click
! 379: # adds ?r2=foo and performs the query.
! 380: # I suppose there's no reason we can't try both and see which one
! 381: # people prefer...
! 382:
! 383: for ($i = 0; $i <= $#revorder; $i++) {
! 384: $_ = $revorder[$i];
! 385: # print "RCS revision <b>$_</b>\n";
! 386: print "<A HREF=\"$scriptwhere?rev=$_\"><b>$_</b></A>";
! 387: if (/^1\.1\.1\.\d+$/) {
! 388: print " <i>(vendor branch)</i>";
! 389: }
! 390: # print "<BR>\n";
! 391: # print "Checked in on <i>" . &ctime($date{$_}) . "</i> by ";
! 392: # print "<i>" . $author{$_} . "</i><BR>\n";
! 393: print " <i>" . &ctime($date{$_}) . "</i> by ";
! 394: print "<i>" . $author{$_} . "</i>\n";
! 395: if ($revsym{$_}) {
! 396: # print "CVS Tags: <b>$revsym{$_}</b><BR>\n";
! 397: print "<BR>CVS Tags: <b>$revsym{$_}</b>";
! 398: }
! 399: if (($br = $_) =~ s/\.\d+$// && $revsym{$br}) {
! 400: # print "Branch: <b>$revsym{$br}</b><BR>\n";
! 401: if ($revsym{$_}) {
! 402: print "; ";
! 403: } else {
! 404: print "<BR>";
! 405: }
! 406: print "Branch: <b>$revsym{$br}</b>";
! 407: }
! 408: # Find the previous revision on this branch.
! 409: # I think this can be done algorithmically.
! 410: @prevrev = split(/\./, $_);
! 411: if (--$prevrev[$#prevrev] == 0) {
! 412: # If it was X.Y.Z.1, just make it X.Y
! 413: if ($#prevrev > 1) {
! 414: pop(@prevrev);
! 415: pop(@prevrev);
! 416: } else {
! 417: # It was rev 1.1 (XXX does CVS use revisions
! 418: # greater than 1.x?)
! 419: if ($prevrev[0] != 1) {
! 420: print "<i>* I can't figure out the previous revision! *</i>\n";
! 421: }
! 422: }
! 423: }
! 424: if ($prevrev[$#prevrev] != 0) {
! 425: $prev = join(".", @prevrev);
! 426: print "<BR><A HREF=\"$scriptwhere?r1=$prev";
! 427: print "&r2=$_\">Diffs to $prev</A>\n";
! 428: #
! 429: # Plus, if it's on a branch, and it's not a vendor branch,
! 430: # offer to diff with the immediately-preceding commit if it
! 431: # is not the previous revision as calculated above
! 432: # and if it is on the HEAD (or at least on a higher branch)
! 433: # (e.g. change gets committed and then brought
! 434: # over to -stable)
! 435: if (!/^1\.1\.1\.\d+$/ && ($i != $#revorder) &&
! 436: ($prev ne $revorder[$i+1])) {
! 437: @tmp1 = split(/\./, $revorder[$i+1]);
! 438: @tmp2 = split(/\./, $_);
! 439: if ($#tmp1 < $#tmp2) {
! 440: print "; <A HREF=\"$scriptwhere?r1=$revorder[$i+1]";
! 441: print "&r2=$_\">Diffs to $revorder[$i+1]</A>\n";
! 442: }
! 443: }
! 444: }
! 445: # print "Log message:<BR>\n";
! 446: print "<PRE>\n";
! 447: print &htmlify($log{$_});
! 448: print "</PRE><HR>\n";
! 449: }
! 450: print "<A NAME=diff>\n";
! 451: print "This form allows you to request diff's between any two\n";
! 452: print "revisions of a file. You may select a symbolic revision\n";
! 453: print "name using the selection box or you may type in a numeric\n";
! 454: print "name using the type-in text box.\n";
! 455: print "</A><P>\n";
! 456: print "<FORM METHOD=\"GET\" ACTION=\"$scriptwhere\">\n";
! 457: print "Diffs between \n";
! 458: print "<SELECT NAME=\"r1\">\n";
! 459: print "<OPTION VALUE=\"text\" SELECTED>Use Text Field\n";
! 460: print $sel;
! 461: print "</SELECT>\n";
! 462: print "<INPUT TYPE=\"TEXT\" NAME=\"tr1\" VALUE=\"$revorder[$#revorder]\">\n";
! 463: print " and \n";
! 464: print "<SELECT NAME=\"r2\">\n";
! 465: print "<OPTION VALUE=\"text\" SELECTED>Use Text Field\n";
! 466: print $sel;
! 467: print "</SELECT>\n";
! 468: print "<INPUT TYPE=\"TEXT\" NAME=\"tr2\" VALUE=\"$revorder[0]\">\n";
! 469: print "<BR><INPUT TYPE=RADIO NAME=\"f\" VALUE=u CHECKED>Unidiff<br>\n";
! 470: print "<INPUT TYPE=RADIO NAME=\"f\" VALUE=c>Context diff<br>\n";
! 471: print "<INPUT TYPE=SUBMIT VALUE=\"Get Diffs\">\n";
! 472: print "</FORM>\n";
! 473: print "<hr>
! 474: <a href=\"/\"><img src=\"/gifs/home.gif\" alt=\"FreeBSD Home
! 475: Page\" border=\"0\" align=\"right\"></a>
! 476: <address>
! 477: <a href=\"/mailto.html\">www@freebsd.org</a>
! 478: </address>\n";
! 479: # print "<HR>\n";
! 480: # print "<A HREF=\"/\"><IMG SRC=\"/gifs/home.gif\" ALT=\"FreeBSD Home Page\">\n";
! 481: # print "</A>\n";
! 482: print "</BODY></HTML>\n";
! 483: } else {
! 484: &fatal("404 Not Found","$where: no such file or directory");
! 485: }
! 486:
! 487: sub htmlify {
! 488: local($string) = @_;
! 489:
! 490: $string =~ s/</</g;
! 491: $string =~ s/>/>/g;
! 492:
! 493: $string;
! 494: }
! 495:
! 496: sub link {
! 497: local($name, $where) = @_;
! 498:
! 499: "<A HREF=\"$where\">$name</A>\n";
! 500: }
! 501:
! 502: sub revcmp {
! 503: local($rev1, $rev2) = @_;
! 504: local(@r1) = split(/\./, $rev1);
! 505: local(@r2) = split(/\./, $rev2);
! 506: local($a,$b);
! 507:
! 508: while (($a = pop(@r1)) && ($b = pop(@r2))) {
! 509: if ($a != $b) {
! 510: return $a <=> $b;
! 511: }
! 512: }
! 513: if (@r1) { return 1; }
! 514: if (@r2) { return -1; }
! 515: return 0;
! 516: }
! 517:
! 518: sub fatal {
! 519: local($errcode, $errmsg) = @_;
! 520: print "Status: $errcode\n";
! 521: print "Content-type: text/html\n";
! 522: print "\n";
! 523: print "<HTML><HEAD><TITLE>Error</TITLE></HEAD>\n";
! 524: print "<BODY>Error: $errmsg</BODY></HTML>\n";
! 525: exit(1);
! 526: }
CVSweb
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to cvsweb.cgi CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [cvsweb.bsd.lv] / cvsweb