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