mozilla
/
mozilla-history
зеркало из https://github.com/mozilla/mozilla-history.git
1
0
Форкнуть 0
Код Задачи Пакеты Проекты Релизы Вики Активность

Bonsai and Tinderbox have been freed.

This commit is contained in:
terry 1998-06-16 21:43:24 +00:00
Родитель 1394aed0fa
Коммит a5ab99df60
98 изменённых файлов: 14642 добавлений и 0 удалений
Показать статистику Скачать Patch файл Скачать Diff файл Показать все файлы Свернуть все файлы

0
webtools/bonsai/CGI.tcl Executable file
Просмотреть файл

22
webtools/bonsai/Makefile Executable file
Просмотреть файл

@ -0,0 +1,22 @@
#!gmake
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Bonsai CVS tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
CFLAGS = -g
trapdoor: trapdoor.o
cc -o trapdoor trapdoor.o

460
webtools/bonsai/README Normal file
Просмотреть файл

@ -0,0 +1,460 @@
This is Bonsai. See <http://www.mozilla.org/bonsai.html>.
=================================
What's What in the Bonsai sources:
=================================
CGI.tcl ???
Makefile: builds the "trapdoor" program
SourceChecker.cgi scc wrote to help sanitize code. DELETE
Called by: nobody
SourceChecker.pm ???
addcheckin.tcl ???
admin.cgi TCL. Select from various administrative tasks
(which require a password.)
Called by: toplevel.cgi
Calls:
doadmin.cgi password=<text> treeid=<text>
command=[open|close]
closetimestamp=<time-text>
lastgood=<time-text>
doclear=<checkbox>
doadmin.cgi password=<text> treeid=<text>
command=tweaktimes
lastgood=<time-text>
lastclose=<time-text>
doadmin.cgi password=<text> treeid=<text>
command=editmotd
origmotd=<text>
motd=<text>
editmessage.cgi treeid=<text>
msgname=[openmessage|closemessage|
treeopened|treeopenedsamehook|
treeclosed]
#### note: no password?
repophook.cgi password=<text> treeid=<text>
command=repophook
startfrom=<time-text>
rebuildtaginfo.cgi password=<text>
treeid=<text>
command=rebuildtaginfo
rebuildcvshistory.cgi password=<text>
treeid=<text>
command=rebuildcvs
startfrom=<time-text>
firstfile=<time-text>
subdir=<time-text>
doadmin.cgi password=<text> treeid=<text>
command=changepassword
password=<text>
newpassword=<text>
newpassword2=<text>
doglobal=<radio>
adminfuncs.tcl ???
adminmail.tcl ???
bonsai.gif uh, a corrupted gif file.
branchspam.cgi failed attempt to web-afy branch spam too DELETE
Called by: nobody
Calls: branchspammer.cgi
branchspammer.cgi more garbage
Called by: branchspam.cgi
Calls: nobody
changebar.tcl ???
closemessage ???
configure/ ???
contacthelp.html ???
countcheckins.cgi TCL. Draws a graph of checkins for the various
Bonsai 'hooks'.
Called by: toplevel.cgi
Calls: nobody
createlegaldirs.tcl ???
crontab ???
cvsblame.cgi Runs through a CVS file and tells you who changed what.
Calls:
rview.cgi dir= cvsroot= rev=
cvsblame.cgi file= rev= root= mark=
cvsblame.cgi set_line= (cookie magic?)
cvsblame.cgi root= file= rev= use_html=
Called by:
cvsguess.cgi
moduleanalyse.cgi
Used to be called by:
cvslog.cgi
cvsblame.pl ???
cvsguess.cgi Given a file name, try to figure out what directory
it's in. then link to cvsblame.cgi. parameters are
the same.
Seems to take an exact file name (sans directory),
then do a redirect to cvsblame.cgi. If there are
more than one file of that name, it presents a list.
This is (I think) redundant with LXR's file name
search.
Calls:
cvsblame.cgi file= rev= mark= #
Called by: nobody
cvsindex.pl ???
cvslog.cgi Web interface to "cvs log".
Calls:
rview.cgi dir= cvsroot= rev=
cvslog.cgi file= root= rev=
sort=[revision|date|author]
author=
cvsview2.cgi
command=DIFF_FRAMESET
diff_mode=context
whitespace_mode=show
root= subdir= file=
rev1= rev2=
cvsview2.cgi
command=DIRECTORY
subdir= files= root= branch=
Used to call:
cvsblame.cgi file= rev= root=
cvsmenu.pl ???
cvsquery.cgi Displays the results of a query entered in cvsqueryform
Called by:
cvsqueryform.cgi
Calls:
cvsqueryform.cgi
cvsview2 command=DIRECTORY
subdir= files= branch= root=
cvsview2.cgi command=DIFF_FRAMESET
diff_mode=context
whitespace_mode=show
subdir= file= rev1= rev2= root=
multidiff.cgi name=allchanges cvsroot=
cvsquery.cgi sortby=
../registry/who.cgi email=
http://scopus.mcom.com/bugsplat/show_bug.cgi
cvsquery.pl ???
cvsqueryform.cgi Main screen to let you query the CVS database.
Called by:
cvsblame.cgi
cvslog.cgi
cvsquery.cgi
toplevel.cgi
Calls:
cvsregexp.html
cvsquery.cgi
module=[all|allrepositories|?]
branch=
branchtype=[match|regexp]
directory=<text>
file=<text>
who=<text>
whotype=[match|regexp]
sortby=[Date|Who|File|Change Size]
date=[hours|day|week|month|all|
explicit]
hours=
mindate=
maxdate=
cvsroot=
cvsregexp.html ???
cvsview2.cgi Lets you view CVS diffs.
Called by:
cvsblame.cgi
cvslog.cgi
cvsquery.cgi
show2.cgi
showcheckins.cgi
Calls:
rview.cgi dir= cvsroot= rev=
cvsview2.cgi subdir= command=DIFF
root= file= rev1= rev2=
cvsview2.cgi subdir= command=DIFF_LINKS
root= file= rev1= rev2=
cvsview2.cgi subdir= command=DIFF
root= file= rev1= rev2= #
cvsview2.cgi subdir= command=DIFF_FRAMESET
root= file= rev1= rev2=
cvsview2.cgi subdir= command=DIRECTORY
root= files= branch= skip=
cvsview2.cgi subdir= command=LOG
root= file= rev=
doadmin.cgi TCL. Executes admin things asked for in admin.cgi
Called by:
admin.cgi
Calls:
mailto:clienteng
doeditcheckin.cgi TCL. Edits a checkin on the hook.
Called by:
editcheckin.cgi
Calls:
nobody
doeditmessage.cgi TCL. Edits one of the email messages that bonsai sends
people.
Called by:
editmessage.cgi
Calls:
nobody
doeditprofile.cgi TCL. Edit peoples contact info. Left-over code from
before we started getting this info from LDAP.
Called by:
editprofile.cgi
Calls:
nobody
doeditwhiteboard.cgi TCL. Edits the free-for-all whiteboard.
Called by:
editwhiteboard.cgi
Calls:
nobody
dolog.pl ???
dotweak.cgi TCL. Tweaks a bunch of checkins in ahook at once.
Called by:
show2.cgi
showcheckins.cgi
Calls:
nobody
editcheckin.cgi TCL. Edits a checkin on the hook.
Called by:
show2.cgi
showcheckins.cgi
Calls:
doeditcheckin.cgi
editmessage.cgi TCL. Edits one of the email messages that bonsai sends
people.
Called by:
admin.cgi
Calls:
doeditmessage.cgi
editprofile.cgi TCL. Edit peoples contact info. Left-over code from
before we started getting this info from LDAP.
Called by:
localprofile.cgi
Calls:
doeditprofile.cgi
editwhiteboard.cgi TCL. Edits the free-for-all whiteboard.
Called by:
toplevel.cgi
Calls:
doeditwhiteboard.cgi
globals.tcl ???
handleAdminMail.tcl ???
handleCheckinMail.tcl ???
header.pl ???
index.html ???
indextest.pl ???
lloydcgi.pl parses CGI args from $QUERY_STRING and leaves them
in $form{$key}; and puts cookies in %cookie_jar.
Calls: nobody
Called by: everybody
localprofile.cgi TCL. Display peoples contact info. Left-over code
from before we started getting this info from LDAP.
Called by:
nobody
Calls:
editprofile.cgi
profile.cgi
maketables.sh ???
Unused?
moduleanalyse.cgi Shows the directories in a module.
Called by:
nobody
Calls:
moduleanalyse.cgi module=[all|?] cvsroot=
rview.cgi dir= cvsroot=
cvsblame.cgi file= root=
modules.pl ???
Called by:
branchspam.cgi
cvsqueryform.cgi
moduleanalyse.cgi
multidiff.cgi Implements the "Show me ALL the Diffs" button
Called by:
cvsquery.cgi
show2.cgi
showcheckins.cgi
Calls:
nobody
myglobrecur.tcl ???
openmessage ???
perlifyconfig.tcl ???
processqueue.pl ???
profile.cgi TCL. Stupid interface to LDAP to show all the info
about a person.
Called by:
localprofile.cgi
show2.cgi
Calls:
profile.cgi person=
rebuildcvshistory.cgi TCL. Admin script to go rebuild the bonsai database
from CVS.
Called by:
admin.cgi
Calls:
nobody
rebuilddatabase.tcl ???
rebuildtaginfo.cgi TCL. Half-written piece of junk to try and remember
things about tags. Should probably nuke it.
Called by:
admin.cgi
repophook.cgi TCL. Rebuilds a bonsai hook from the bonsai database.
Called by:
admin.cgi
Calls:
nobody
reposfiles.pl ???
rview.cgi Lets you browse a directory in a CVS repository.
Called by:
cvsblame.cgi
cvslog.cgi
cvsview2.cgi
moduleanalyse.cgi
Calls:
rview.cgi dir= cvsroot= rev=
rview.cgi dir= cvsroot= rev= ?=chdir
rview.cgi dir= cvsroot= rev= ?=Set Branch
&make_cgi_args ???
../registry/file.cgi cvsroot= file= dir=
show2.cgi TCL. This seems to be a variant on showcheckins.cgi?
Called by:
nobody
Calls:
dotweak.cgi
showcheckins.cgi [various funky args]
editcheckin.cgi id= [various funky args]w
profile.cgi person= [various funky args]
cvsview2.cgi subdir= files= command=DIRECTORY
branch=
http://w3/cgi/cvsview2.cgi subdir= files=
command=DIRECTORY
multidiff.cgi allchanges=
showcheckins.cgi TCL. Shows some set of checkins in a bonsai hook.
Called by:
admin.cgi
show2.cgi
toplevel.cgi
Calls:
dotweak.cgi
showcheckins.cgi [various funky args]
editcheckin.cgi id= [various funky args]w
http://phonebook/ds/dosearch/phonebook/...
cvsview2.cgi root= subdir= files=
command=DIRECTORY branch=
http://w3/cgi/cvsview2.cgi subdir= files=
command=DIRECTORY
multidiff.cgi allchanges=
status/ ???
switchtree.cgi TCL. Lets you choose a different bonsai branch.
Called by:
toplevel.cgi
Calls:
nobody
testlock.pl ???
toplevel.cgi TCL. Main interface to the bonsai hook.
Called by:
CGI.tcl
contacthelp.html
index.html
sheriff2.html
switchtree.cgi
toplevel.cgi
viewold.cgi
Calls:
editwhiteboard.cgi [...]
http://phonebook/ds/dosearch/phonebook/...
showcheckins.cgi
http://warp/tinderbox/showbuilds.cgi
switchtree.cgi [...]
news:mcom.dev.client.build.busted
http://phonebook/
viewold.cgi [...]
countcheckins.cgi [...]
admin.cgi [...]
index.html
http://warp/client/dogbert/tree.html
contacthelp.html
http://warp/client/dogbert/buildlore/index.html
trapdoor.c ???
utils.pl ???
viewold.cgi TCL. Lets you choose an old bonsai hook to view.
Called by:
toplevel.cgi
Calls:
toplevel.cgi treeid=

237
webtools/bonsai/SourceChecker.cgi Executable file
Просмотреть файл

@ -0,0 +1,237 @@
#!/usr/bonsaitools/bin/perl --
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Bonsai CVS tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
# SourceChecker.cgi -- tools for creating or modifying the dictionary
# used by cvsblame.cgi.
#
# Created: Scott Collins <scc@netscape.com>, 4 Feb 1998.
#
# Arguments (passes via GET or POST):
# ...
#
use CGI;
use SourceChecker;
#
# Global
#
$query = new CGI;
#
# Subroutines
#
sub print_page_header()
{
print <<'END_OF_HEADER';
<H1>SourceChecker Dictionary Maintainance</H1>
END_OF_HEADER
}
sub print_page_trailer()
{
print <<'END_OF_TRAILER';
<HR>
<FONT SIZE=-1>
Last updated 5 Feb 1998.
<A HREF="SourceChecker.cgi">Dictionary maintainance and help</A>.</FONT>
Mail feedback to <A HREF="mailto:scc?subject=[SourceChecker.cgi]">&lt;scc@netscape.com&gt;</A>.
END_OF_TRAILER
}
$error_header = '<HR><H2>I couldn\'t process your request...</H2>';
sub print_error($)
{
local $message = shift;
print "$error_header<P><EM>Error</EM>: $message</P>";
$error_header = '';
}
sub print_query_building_form()
{
print $query->start_multipart_form;
print '<HR><H2>Build a new request</H2>';
print '<P>...to modify or create a remote dictionary with words from one or more local files.</P>';
print '<H3>Files on the server</H3>';
print '<P>...i.e., the dictionary to be created or modified.</P>';
print $query->textfield( -name=>'dictionary',
-default=>'',
-override=>1,
-size=>30 );
print '-- the path to dictionary.';
print '<H3>Files on your local machine</H3>';
print '<P>...that will be uploaded to the server, so their contents can be added to the dictionary.</P>';
print '<BR>';
print $query->filefield( -name=>'ignore_english', -size=>30 );
print '-- contains english (i.e., transformable) words to ignore.';
print '<BR>';
print $query->filefield( -name=>'ignore_strings', -size=>30 );
print '-- contains identifiers (i.e., non-transformable) words to ignore.';
print '<BR>';
print $query->filefield( -name=>'flag_strings', -size=>30 );
print '-- contains identifiers words to be flagged.';
print '<BR>';
print $query->filefield( -name=>'ignore_names', -size=>30 );
print '-- contains user names to be ignored.';
print '<BR>';
print $query->submit;
print $query->endform;
}
sub do_add_good_words($)
{
local $file = shift;
while ( <$file> )
{
next if /\#/;
add_good_words($_);
}
}
sub do_add_bad_words($)
{
local $file = shift;
while ( <$file> )
{
next if /\#/;
add_bad_words($_);
}
}
sub do_add_good_english($)
{
local $file = shift;
while ( <$file> )
{
next if /\#/;
add_good_english($_);
}
}
sub do_add_names($)
{
local $file = shift;
while ( <$file> )
{
next if /\#/;
add_names($_);
}
}
sub handle_query()
{
$dictionary_path = $query->param('dictionary');
if ( ! $dictionary_path )
{
print_error('You didn\'t supply a path to the dictionary file.');
return;
}
dbmopen %SourceChecker::token_dictionary, "$dictionary_path", 0666
|| print_error("The dictionary you named could not be opened.");
$added_some_words = 0;
if ( $file_of_good_english = $query->param('ignore_english') )
{
do_add_good_english($file_of_good_english);
$added_some_words = 1;
}
if ( $file_of_good_words = $query->param('ignore_strings') )
{
do_add_good_words($file_of_good_words);
$added_some_words = 1;
}
if ( $file_of_bad_words = $query->param('flag_strings') )
{
do_add_bad_words($file_of_bad_words);
$added_some_words = 1;
}
if ( $file_of_names = $query->param('ignore_names') )
{
do_add_names($file_of_names);
$added_some_words = 1;
}
if ( ! $added_some_words )
{
print_error("You did not supply any words to add to the dictionary.");
}
dbmclose %SourceChecker::token_dictionary;
}
#
# The main script
#
print $query->header;
print $query->start_html(-title=>'SourceChecker Dictionary Maintainance',
-author=>'scc@netscape.com');
print_page_header();
if ( $query->param )
{
handle_query();
}
print_query_building_form();
print_page_trailer();
print $query->end_html;
__DATA__

192
webtools/bonsai/SourceChecker.pm Executable file
Просмотреть файл

@ -0,0 +1,192 @@
# -*- Mode: perl; tab-width: 4; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Bonsai CVS tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
package SourceChecker;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(%token_dictionary, add_good_english, add_good_words, add_bad_words, add_names, tokenize_line, markup_line);
@EXPORT_OK = qw($GOOD_TOKEN, $UNKNOWN_TOKEN, $BAD_TOKEN, $NAME_TOKEN, add_token, canonical_token, @markup_prefix, @markup_suffix);
$GOOD_TOKEN = \-1;
$UNKNOWN_TOKEN = \0;
$NAME_TOKEN = \1;
$BAD_TOKEN = \2;
@markup_prefix = ('<FONT COLOR="green">', '<FONT COLOR="red">', '<FONT COLOR="blue">');
@markup_suffix = ('</FONT>', '</FONT>', '</FONT>');
sub canonical_token($)
{
my $token = shift;
if ( defined $token )
{
$token =~ s/[\'Õ\&]+//g;
$token = length($token)>2 ? lc $token : undef;
}
$token;
}
sub _push_tokens($$)
{
# Note: inherits |@exploded_phrases| and |@exploded_tokens| from caller(s)
push @exploded_phrases, shift;
push @exploded_tokens, canonical_token(shift);
}
sub _explode_line($)
{
# Note: inherits (and returns results into) |@exploded_phrases| and |@exploded_tokens| from caller(s)
my $line = shift;
my $between_tokens = 0;
foreach $phrase ( split /([A-Za-z\'Õ\&]+)/, $line )
{
if ( $between_tokens = !$between_tokens )
{
_push_tokens($phrase, undef);
next;
}
for ( $_ = $phrase; $_; )
{
m/^[A-Z\'Õ\&]*[a-z\'Õ\&]*/;
$token = $&;
$_ = $';
if ( ($token =~ m/[A-Z][a-z\'Õ]+/) && $` )
{
$token = $&;
_push_tokens($`, $`);
}
_push_tokens($token, $token);
}
}
$#exploded_phrases;
}
sub tokenize_line($)
{
my $line = shift;
local @exploded_tokens;
_explode_line($line);
my $i = -1;
foreach $token ( @exploded_tokens )
{
$exploded_tokens[++$i] = $token if defined $token;
}
$#exploded_tokens = $i;
@exploded_tokens;
}
sub markup_line($)
{
my $line = shift;
local @exploded_phrases;
local @exploded_tokens;
_explode_line($line);
$i = 0;
foreach $phrase ( @exploded_phrases )
{
$phrase =~ s/&/&amp;/g;
$phrase =~ s/</&lt;/g;
$phrase =~ s/>/&gt;/g;
my $token = $exploded_tokens[$i];
if ( defined $token && ($token_kind = $token_dictionary{$token}) >= 0 )
{
$phrase = $markup_prefix[$token_kind] . $phrase . $markup_suffix[$token_kind];
}
++$i;
}
join '', @exploded_phrases;
}
sub add_token($$)
{
(my $token, my $token_kind) = @_;
if ( !defined $token_dictionary{$token} || ($token_kind > $token_dictionary{$token}) )
{
$token_dictionary{$token} = $token_kind;
}
}
sub add_good_english($)
{
my $line = shift;
foreach $token ( tokenize_line($line) )
{
add_token($token, $$GOOD_TOKEN);
my $initial_char = substr($token, 0, 1);
(my $remainder = substr($token, 1)) =~ s/[aeiouy]+//g;
$abbreviated_length = length($remainder) + 1;
if ( $abbreviated_length != length($token) && $abbreviated_length > 2 )
{
add_token("$initial_char$remainder", $$GOOD_TOKEN);
}
}
}
sub _add_tokens($$)
{
(my $line, my $token_kind) = @_;
foreach $token ( tokenize_line($line) )
{
add_token($token, $token_kind);
}
}
sub add_good_words($)
{
_add_tokens(shift, $$GOOD_TOKEN);
}
sub add_bad_words($)
{
_add_tokens(shift, $$BAD_TOKEN);
}
sub add_names($)
{
_add_tokens(shift, $$NAME_TOKEN);
}
1;

250
webtools/bonsai/addcheckin.tcl Executable file
Просмотреть файл

@ -0,0 +1,250 @@
#!/usr/bonsaitools/bin/mysqltcl
# -*- Mode: tcl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Bonsai CVS tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
source globals.tcl
# cmdtrace on
assert {![info exists checkinlist]}
set inheader 1
set foundlogline 0
proc trim {str} {
return [string trim $str]
}
set filelist {}
set log {}
set appendjunk {}
set repository {/m/src}
if {[cequal [lindex $argv 0] "-treeid"]} {
lvarpop argv
set forcetreeid [lvarpop argv]
}
# Stupid hack to make empty array
set group(xyzzy) 1
unset group(xyzzy)
for_file line $argv {
set line [trim $line]
if {$inheader} {
switch -glob -- $line {
{} {
set inheader 0
}
}
} elseif {!$foundlogline} {
switch -glob -- $line {
{?|*} {
append appendjunk "$line\n"
lassign [split $line "|"] chtype date name repository dir \
file version sticky branch addlines removelines
set key [list $date $branch $repository $dir $name]
lappend group($key) [list $file $version $addlines \
$removelines $sticky]
}
{Tag|*} {
set data [split $line "|"]
lvarpop data
set repository [lvarpop data]
set tagtime [lvarpop data]
set tagname [lvarpop data]
regsub -all -- / $repository _ mungedname
set filename "data/taginfo/$mungedname/[MungeTagName $tagname]"
Lock
if {[catch {set fid [open "$filename" "a"]}]} {
catch {mkdir data/taginfo}
catch {chmod 0777 data/taginfo}
catch {mkdir data/taginfo/$mungedname}
catch {chmod 0777 data/taginfo/$mungedname}
set fid [open "$filename" "a"]
}
puts $fid "$tagtime|[join $data {|}]"
close $fid
catch {chmod 0666 $filename}
Unlock
}
{LOGCOMMENT} {
set foundlogline 1
}
}
} else {
if {[cequal $line ":ENDLOGCOMMENT"]} {
break
}
append log "$line\n"
}
}
set plainlog $log
set log [html_quote [trim $log]]
regsub -all -- {[0-9][0-9][0-9][0-9][0-9]*} $log $BUGSYSTEMEXPR log
Lock
LoadTreeConfig
if {![info exists forcetreeid]} {
regsub -all -- / $repository _ mungedname
set filename "data/checkinlog$mungedname"
set fid [open $filename "a"]
catch {chmod 0666 $filename}
puts $fid "[set appendjunk]LOGCOMMENT\n$plainlog\n:ENDLOGCOMMENT"
close $fid
ConnectToDatabase
AddToDatabase $appendjunk $plainlog
}
Unlock
if {[info exists forcetreeid]} {
set treestocheck $forcetreeid
} else {
set treestocheck $treelist
}
foreach key [array names group] {
lassign $key date branch repository dir name
set branch2 [crange $branch 1 end]
set files {}
set fullinfo {}
foreach i $group($key) {
lassign $i file version addlines removelines
lappend files $file
lappend fullinfo $i
}
foreach treeid $treestocheck {
if {[info exists treeinfo($treeid,nobonsai)]} {
continue
}
if {![cequal $branch $treeinfo($treeid,branch)] && \
![cequal $branch2 $treeinfo($treeid,branch)]} {
continue
}
if {![cequal $repository $treeinfo($treeid,repository)]} {
continue
}
LoadDirList
set okdir 0
# Sigh. We have some specific files listed as well as modules. So,
# painfully go through *every* file we're checking in, and see if any
# of them are ones we're interested in.
foreach f $files {
set full $dir/$f
foreach d $legaldirs {
if {[string match $d $full]} {
set okdir 1
break
}
}
if {$okdir} {
break
}
}
if {$okdir} {
Lock
catch {unset batchid}
catch {unset checkinlist}
LoadCheckins
set id checkin-$date-[id process]
lappend checkinlist $id
upvar #0 $id foo
set foo(person) $name
set foo(date) $date
set foo(dir) $dir
set foo(files) $files
set foo(log) $log
set foo(treeopen) $treeopen
set foo(fullinfo) $fullinfo
WriteCheckins
Log "Added checkin $name $dir $files"
Unlock
if {$treeopen} {
set filename [DataDir]/openmessage
foreach i $checkinlist {
upvar #0 $i info
if {[cequal $info(person) $name]} {
if {![cequal $id $i]} {
# This person already has a checkin, so we don't
# need to bother him again.
set filename thisFileDoesntExist
}
}
}
} else {
set filename [DataDir]/closemessage
}
if {![info exists forcetreeid] && [file exists $filename]} {
set fid [open $filename "r"]
set text [read $fid]
close $fid
set profile [GenerateProfileHTML $name]
set nextclose {[We don't remember close times any more...]}
foreach k {name dir files log profile nextclose} {
regsub -all -- "%$k%" $text [set $k] text
}
exec /usr/lib/sendmail -t << $text
Log "Mailed file $filename to $name"
}
}
}
}
NOTDEF {
set tmp $log
while {[regexp -nocase -- {.*bugfix([ 0-9]*)(.*)$} $tmp foo list tmp]} {
set fileversions {}
foreach i [array names group] {
lassign $i file version
lappend $fileversions [list $file $version]
}
foreach b $list {
set result [exec /usr/local/bin/lynx -dump "http://scopus.mcom.com/terrsplat/doclosebug.cgi?id=$b&directory=$dir&fileversions=$fileversions&who=$name&log=$plainlog"]
if {$result != "OK\n"} {
}
}
}
}
exit

205
webtools/bonsai/admin.cgi Executable file
Просмотреть файл

@ -0,0 +1,205 @@
#!/usr/bonsaitools/bin/mysqltcl
# -*- Mode: tcl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Bonsai CVS tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
source CGI.tcl
Lock
LoadCheckins
LoadMOTD
LoadTreeConfig
Unlock
puts "Content-type: text/html
<html>
<head>
<title>Bonsai administration</title>
</head>
<body>
<h1>Bonsai administration</h1>
You realize, of course, that you have to know the magic password to do
anything from here.
<hr>
<a href=showcheckins.cgi?tweak=1[BatchIdPart]>Go tweak bunches of checkins at once.</a>
<hr>
"
puts "
<FORM method=get action=\"doadmin.cgi\">
<B>Password:</B> <INPUT NAME=password TYPE=password> <BR>
<INPUT TYPE=HIDDEN NAME=treeid VALUE=$treeid>
"
if {$treeopen} {
puts "
<INPUT TYPE=HIDDEN NAME=command VALUE=close>
<B>Closing time stamp is:</B>
<INPUT NAME=closetimestamp VALUE=\"[value_quote [MyFmtClock [getclock]]]\"><BR>
<INPUT TYPE=SUBMIT VALUE=\"Close the tree\">
"
} else {
puts "
<INPUT TYPE=HIDDEN NAME=command VALUE=open>
<B>The new \"good\" timestamp is:</B>
<INPUT NAME=lastgood VALUE=\"[value_quote [MyFmtClock [getclock]]]\">
<BR>
<INPUT TYPE=CHECKBOX NAME=doclear CHECKED>Clear the list of checkins.<BR>
<INPUT TYPE=SUBMIT VALUE=\"Open the tree\">
"
}
puts "
</FORM>
<hr>
<FORM method=get action=\"doadmin.cgi\">
<B>Password:</B> <INPUT NAME=password TYPE=password> <BR>
<INPUT TYPE=HIDDEN NAME=treeid VALUE=$treeid>
<INPUT TYPE=HIDDEN NAME=command VALUE=tweaktimes>
<TABLE>
<TR>
<TD><B>Last good timestamp:</B></TD>
<TD><INPUT NAME=lastgood VALUE=\"[value_quote [MyFmtClock $lastgoodtimestamp]]\"></TD>
</TR><TR>
<TD><B>Last close timestamp:</B></TD>
<TD><INPUT NAME=lastclose VALUE=\"[value_quote [MyFmtClock $closetimestamp]]\"></TD>
</TR>
</TABLE>
<INPUT TYPE=SUBMIT VALUE=\"Tweak the timestamps\">
</FORM>
<hr>
<FORM method=get action=\"doadmin.cgi\">
<INPUT TYPE=HIDDEN NAME=treeid VALUE=$treeid>
<B>Password:</B> <INPUT NAME=password TYPE=password> <BR>
<INPUT TYPE=HIDDEN NAME=command VALUE=editmotd>
Change the message-of-the-day:<br>
<INPUT TYPE=HIDDEN NAME=origmotd VALUE=\"[value_quote $motd]\">
<TEXTAREA NAME=motd ROWS=10 COLS=50>$motd</TEXTAREA><BR>
<INPUT TYPE=SUBMIT VALUE=\"Change the MOTD\">
</FORM>
<hr>
<FORM method=get action=\"editmessage.cgi\">
<INPUT TYPE=HIDDEN NAME=treeid VALUE=$treeid>
Change the e-mail message sent:
<SELECT NAME=msgname SIZE=1>
<OPTION VALUE=openmessage>when a checkin is made when the tree is open.
<OPTION VALUE=closemessage>when a checkin is made when the tree is closed.
<OPTION VALUE=treeopened>to the hook when the tree opens
<OPTION VALUE=treeopenedsamehook>to the hook when the tree opens and the hook isn't cleared
<OPTION VALUE=treeclosed>to the hook when the tree closes
</SELECT>
<br>
<INPUT TYPE=SUBMIT VALUE=\"Edit a message\">
</FORM>
<hr>
<FORM method=get action=\"repophook.cgi\">
<INPUT TYPE=HIDDEN NAME=treeid VALUE=$treeid>
<B>Password:</B> <INPUT NAME=password TYPE=password> <BR>
<INPUT TYPE=HIDDEN NAME=command VALUE=repophook>
Repopulate the hook from scratch.<p>
<font color=red size=+2>This can be very dangerous.</font> You should
usually only need to do this to populate a new Bonsai branch.
<p>
<b>Use any checkin since:</b>
<INPUT NAME=startfrom VALUE=\"[value_quote [MyFmtClock $lastgoodtimestamp]]\">
<br>
<INPUT TYPE=SUBMIT VALUE=\"Rebuild the hook\">
</FORM>
<hr>
<FORM method=get action=\"rebuildtaginfo.cgi\">
<INPUT TYPE=HIDDEN NAME=treeid VALUE=$treeid>
<B>Password:</B> <INPUT NAME=password TYPE=password> <BR>
<INPUT TYPE=HIDDEN NAME=command VALUE=rebuildtaginfo>
Recreate the entire table of tags for the $treeinfo($treeid,repository)
repository from scratch.
<p>
<font color=red size=+2>This can take a very, very long time.</font> You
should
usually only need to do this when first introducing an entire CVS repository
into Bonsai. (And, in fact, nothing right now ever even uses that info, so
don't bother unless you know what you're doing.)
<br>
<INPUT TYPE=SUBMIT VALUE=\"Rebuild tag information\">
</FORM>
<hr>
<FORM method=get action=\"rebuildcvshistory.cgi\">
<INPUT TYPE=HIDDEN NAME=treeid VALUE=$treeid>
<B>Password:</B> <INPUT NAME=password TYPE=password> <BR>
<INPUT TYPE=HIDDEN NAME=command VALUE=rebuildcvs>
Recreate the entire list of every checkin ever done to the
$treeinfo($treeid,repository) repository from scratch.
<p>
<font color=red size=+2>This can take an incredibly long time.</font> You
should
usually only need to do this when first introducing an entire CVS repository
into Bonsai.
<p>
<b>Ignore checkins earlier than:</b>
<INPUT NAME=startfrom VALUE=\"[value_quote [MyFmtClock 0]]\">
<br>
<b>Ignore files before (must be full path starting with $treeinfo($treeid,repository); leave blank to do everything):</b>
<INPUT NAME=firstfile VALUE=\"\" size=50>
<br>
<b>Only do files within the subdirectory of $treeinfo($treeid,repository) named:</b>
<INPUT NAME=subdir VALUE=\".\" size=50>
<br>
<INPUT TYPE=SUBMIT VALUE=\"Rebuild cvs history\">
</FORM>
<hr>
<FORM method=post action=\"doadmin.cgi\">
<INPUT TYPE=HIDDEN NAME=treeid VALUE=$treeid>
<INPUT TYPE=HIDDEN NAME=command VALUE=changepassword>
Change password.<BR>
<B>Old password:</B> <INPUT NAME=password TYPE=password> <BR>
<B>New password:</B> <INPUT NAME=newpassword TYPE=password> <BR>
<B>Retype new password:</B> <INPUT NAME=newpassword2 TYPE=password> <BR>
<INPUT TYPE=RADIO NAME=doglobal VALUE=0 CHECKED>Change password for this tree<BR>
<INPUT TYPE=RADIO NAME=doglobal VALUE=1>Change master Bonsai password<BR>
<INPUT TYPE=SUBMIT VALUE=\"Change the password\">
</FORM>
"
PutsTrailer
exit

84
webtools/bonsai/adminfuncs.tcl Executable file
Просмотреть файл

@ -0,0 +1,84 @@
# -*- Mode: tcl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Bonsai CVS tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
proc AdminOpenTree {lastgood clearp} {
global lastgoodtimestamp treeopen checkinlist
if {$treeopen} {
return
}
set lastgoodtimestamp $lastgood
set treeopen 1
PickNewBatchID
if {$clearp} {
SendMail treeopened
set checkinlist {}
} else {
SendMail treeopenedsamehook
}
Log "Tree opened. lastgood is [MyFmtClock $lastgoodtimestamp]"
}
proc AdminCloseTree {closetime} {
global closetimestamp treeopen
if {!$treeopen} {
return
}
set closetimestamp $closetime
set treeopen 0
SendMail treeclosed
Log "Tree closed. closetime is [MyFmtClock $closetimestamp]"
}
proc MakeHookList {} {
global checkinlist
# First, the hack to make an empty array.
set people(zzz) 1
unset people(zzz)
foreach c $checkinlist {
upvar #0 $c info
set people($info(person)) 1
}
return [lsort [array names people]]
}
proc SendMail {filename} {
set hooklist [join [MakeHookList] ", "]
if {[lempty $hooklist]} {
return
}
set fullfilename [DataDir]/$filename
if {[file exists $fullfilename]} {
set text [read_file $fullfilename]
} else {
set text ""
}
foreach k {hooklist} {
regsub -all -- "%$k%" $text [set $k] text
}
exec /usr/lib/sendmail -t << $text
}

0
webtools/bonsai/adminmail.tcl Executable file
Просмотреть файл

Двоичные данные
webtools/bonsai/bonsai.gif Executable file
Просмотреть файл

Двоичный файл не отображается.
Режим "рядом"

После

Ширина:  |  Высота:  |  Размер: 20 KiB

91
webtools/bonsai/branchspam.cgi Executable file
Просмотреть файл

@ -0,0 +1,91 @@
#!/usr/bonsaitools/bin/perl --
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Bonsai CVS tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
# Query the CVS database.
#
$|=1;
print "Content-type: text/html
<HTML>";
require 'modules.pl';
print "
<HEAD>
<TITLE>The CVS Branch Spammer (TM)</TITLE>
</HEAD>
<H1>The CVS Branch Spammer (TM)</H1>
<p> Questions, Comments, Feature requests? mail <a href=mailto:ltabb>ltabb</a>
<h3>What this tool does</h3>
<p>In the course of software development, it is necessary to form a branch
to do development on for a period of time. Sometimes you want to merge these
changes back into the trunk in one shot. Sometime you want to have the developers
merge the changes themselves, individually. This tool makes sure the developers
have merged their changes in individually.
<p>The CVS Branch Spammer goes out and figures out what changes were made on
a branch and then looks to see if these changes where also made on the tip. It
formulates a mail message and send the mail to the indivual developers. The
individual developers look at the mail and reply that they have made their
changes in the tip.
<p>To run this program answer the following questions and bonk the spam button.
<p>
<FORM METHOD=GET ACTION='branchspammer.cgi'>
";
#
# module selector
#
print "
<nobr><b>Pick the name of the CVS Module you use to pull your source</b>
<SELECT name='module' size=5>
<OPTION SELECTED VALUE='all'>All Files in the Repository
<OPTION SELECTED VALUE='Client40All'>Client40All
";
#
# Print out all the Different Modules
#
for $k (sort( keys( %$modules ) ) ){
print "<OPTION value='$k'>$k\n";
}
print "</SELECT></NOBR>\n";
#
# Branch
#
print "<br><nobr><b>What is the name of your branch:</b> <input type=text name=branch size=25></nobr>\n";
print "<br><nobr><b>Who should the email message be from?:</b> <input type=text name=whofrom size=25></nobr>\n";
print "
<br>
<br>
<INPUT TYPE=SUBMIT VALUE='Run the Branchspammer'>
</FORM>";

100
webtools/bonsai/branchspammer.cgi Executable file
Просмотреть файл

@ -0,0 +1,100 @@
#!/usr/bonsaitools/bin/perl --
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Bonsai CVS tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
require 'lloydcgi.pl';
require 'timelocal.pl';
require 'cvsquery.pl';
$| = 1;
print "Content-type: text/html
<HTML>";
$CHECKIN_DATA_FILE = 'data/checkinlog_m_src';
$CHECKIN_INDEX_FILE = 'data/index_m_src';
#
# build a module map
#
$query_module = $form{'module'};
@query_dirs = split(/[;, \t]+/, $form{'dir'});
$query_date_type = $form{'date'};
$query_date_min = time-(24*60*60*15);
$query_who ='' ;
$query_branch = $form{'branch'};
print "<h1>Running Query, this may take a while...</h1>";
$result= &query_checkins( $mod_map );
#
# Test code to print the results
#
if( 0 ) {
if( $form{"sortby"} eq "Who" ){
$result = [sort {
$a->[$CI_WHO] cmp $b->[$CI_WHO]
|| $b->[$CI_DATE] <=> $a->[$CI_DATE]
} @{$result}] ;
$head_who = $SORT_HEAD;
}
elsif( $form{"sortby"} eq "File" ){
$result = [sort {
$a->[$CI_FILE] cmp $b->[$CI_FILE]
|| $b->[$CI_DATE] <=> $a->[$CI_DATE]
|| $a->[$CI_DIRECTORY] cmp $b->[$CI_DIRECTORY]
} @{$result}] ;
$head_file = $SORT_HEAD;
}
elsif( $form{"sortby"} eq "Directory" ){
$result = [sort {
$a->[$CI_DIRECTORY] cmp $b->[$CI_DIRECTORY]
|| $a->[$CI_FILE] cmp $b->[$CI_FILE]
|| $b->[$CI_DATE] <=> $a->[$CI_DATE]
} @{$result}] ;
$head_directory = $SORT_HEAD;
}
elsif( $form{"sortby"} eq "Change Size" ){
$result = [sort {
($b->[$CI_LINES_ADDED]- $b->[$CI_LINES_REMOVED])
<=> ($a->[$CI_LINES_ADDED]- $a->[$CI_LINES_REMOVED])
#|| $b->[$CI_DATE] <=> $a->[$CI_DATE]
} @{$result}] ;
$head_delta = $SORT_HEAD;
}
else{
$result = [sort {$b->[$CI_DATE] <=> $a->[$CI_DATE]} @{$result}] ;
$head_date = $SORT_HEAD;
}
}
print "<pre>";
for $ci (@$result) {
$ci->[$CI_LOG] = '';
$s = join("|",@$ci);
print "$s\n";
}

0
webtools/bonsai/changebar.tcl Executable file
Просмотреть файл

23
webtools/bonsai/closemessage Normal file
Просмотреть файл

@ -0,0 +1,23 @@
From: bonsai-daemon
To: %name%
Subject: [Bonsai] Hey! You checked in while the tree was closed!
Mime-Version: 1.0
Content-Type: text/html
<HTML>
<H1>Boy, you better have had permission!</H1>
You just checked into <tt>%dir%</tt> the files <tt>%files%</tt>. The
tree is currently frozen. You better have had permission from the build group
to make a checkin; otherwise, you're in deep doo-doo.
<P>
Your contact info and other vital data is listed below. Please
<a href=http://warp/bonsai/profile.cgi?person=%name%>update</a>
this info <b>immediately</b> if it is at all inaccurate or incorrect.
<hr>
%profile%

27
webtools/bonsai/contacthelp.html Normal file
Просмотреть файл

@ -0,0 +1,27 @@
<html> <head>
<title>Changing other people's contact info.</title>
</head>
<body>
<h1>Changing other people's contact info.</h1>
Occasionally, you need to change the "contact info" listed for some
other person. (Like, they just called you on their celphone from the
horrible traffic accident they just got in, and need you to go on the
hook for them.) Well, it's easy. Go ahead onto their contact page,
change the contact info field, and type your own username and UNIX
password to the form. It'll work.
<P>
Note that you're only allowed to change the "Current Contact Info"
field this way. It won't let you change anything else.
<hr>
<a href="toplevel.cgi" target=_top>Back to the top of Bonsai</a>
<hr>
<address><a href="http://home.netscape.com/people/terry/">Terry Weissman &lt;terry@netscape.com&gt;</a></address>
<!-- hhmts start -->
Last modified: Wed Oct 30 13:03:35 1996
<!-- hhmts end -->
</body> </html>

88
webtools/bonsai/countcheckins.cgi Executable file
Просмотреть файл

@ -0,0 +1,88 @@
#!/usr/bonsaitools/bin/mysqltcl
# -*- Mode: tcl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Bonsai CVS tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
source CGI.tcl
set maxsize 400
LoadCheckins
puts "Content-type: text/html
<HTML>
<TITLE>Beancounter central.</TITLE>
<H1>Meaningless checkin statistics</H1>
<TABLE BORDER CELLSPACING=2><TR>
<TH>Tree closed</TH>
<TH>Number<BR>of<BR>people<BR>making<BR>changes</TH>
<TH COLSPAN=2>Number of checkins</TH>
</TR>
"
set list {}
foreach i [glob "[DataDir]/batch-*\[0-9\]"] {
regexp -- {[0-9]*$} $i n
lappend list $n
}
set list [lsort -integer -decreasing $list]
set first 1
set biggest 1
foreach i $list {
source [DataDir]/batch-$i
set num($i) [llength $checkinlist]
if {$num($i) > $biggest} {
set biggest $num($i)
}
if {$first} {
set donetime($i) "Current hook"
set first 0
} else {
set donetime($i) [MyFmtClock $closetimestamp]
}
catch {unset people}
set people(zzz) 1
unset people(zzz)
foreach c $checkinlist {
upvar #0 $c info
set people($info(person)) 1
}
set numpeople($i) [array size people]
}
foreach i $list {
puts "<TR>"
puts "<TD>$donetime($i)</TD>"
puts "<TD ALIGN=RIGHT>$numpeople($i)</TD>"
puts "<TD ALIGN=RIGHT>$num($i)</TD>"
puts "<TD><table WIDTH=[expr $num($i) * $maxsize / $biggest] bgcolor=green><tr><td>&nbsp;</td></tr></table></TD>"
puts "</TR>"
}
puts "</TABLE>"
PutsTrailer
exit

93
webtools/bonsai/createlegaldirs.tcl Executable file
Просмотреть файл

@ -0,0 +1,93 @@
#!/usr/bonsaitools/bin/mysqltcl
# -*- Mode: tcl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Bonsai CVS tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
source globals.tcl
set treeid [lindex $argv 0]
LoadTreeConfig
set modulename $treeinfo($treeid,module)
Log "Attempting to recreate legaldirs..."
proc digest {str} {
global array
set key [lvarpop str]
if {[cequal [cindex [lindex $str 0] 0] "-"]} {
lvarpop str
}
set array($key) $str
}
set env(CVSROOT) $treeinfo($treeid,repository)
set origdir [pwd]
cd /
set fid [open "|/tools/ns/bin/cvs checkout -c" r]
cd $origdir
set curline ""
while {[gets $fid line] >= 0} {
if {[ctype space [cindex $line 0]]} {
append curline $line
} else {
digest $curline
set curline $line
}
}
digest $curline
close $fid
if {![info exists array($modulename)]} {
error "modules file no longer includes $modulename ???"
}
set oldlist {}
set list $modulename
while {![cequal $list $oldlist]} {
set oldlist $list
set list {}
foreach i $oldlist {
if {[info exists array($i)]} {
set list [concat $list $array($i)]
# Do an unset to prevent infinite recursion.
unset array($i)
} else {
lappend list $i
}
}
}
Lock
set fid [open "[DataDir]/legaldirs" "w"]
catch {chmod 0666 "[DataDir]/legaldirs"}
foreach i $list {
puts $fid $i
puts $fid "$i/*"
}
close $fid
Log "...legaldirs recreated."
Unlock
exit

599
webtools/bonsai/cvsblame.cgi Executable file
Просмотреть файл

@ -0,0 +1,599 @@
#!/usr/bonsaitools/bin/perl --
# cvsblame.cgi -- cvsblame with logs as popups and allowing html in comments.
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Bonsai CVS tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
# Created: Steve Lamm <slamm@netscape.com>, 12-Sep-97.
# Modified: Marc Byrd <byrd@netscape.com> , 19971030.
#
# Arguments (passed via GET or POST):
# file - path to file name (e.g. ns/cmd/xfe/Makefile)
# root - cvs root (e.g. /warp/webroot)
# - default includes /m/src/ and /h/rodan/cvs/repository/1.0
# rev - revision (default is the latest version)
# line_nums - boolean for line numbers on/off (use 1,0).
# (1,on by default)
# use_html - boolean for html comments on/off (use 1,0).
# (0,off by default)
# sanitize - path to sanitization dictionary
# (e.g. /warp2/webdoc/projects/bonsai/dictionary/sanitization.db)
# mark - highlight a line
#
require 'lloydcgi.pl';
require 'cvsblame.pl';
require 'utils.pl';
use SourceChecker;
$| = 1;
# Cope with the cookie and print the header, first thing. That way, if
# any errors result, they will show up for the user.
print "Content-Type:text/html\n";
if ($ENV{"REQUEST_METHOD"} eq 'POST' && defined($form{'set_line'})) {
# Expire the cookie 5 months from now
print "Set-Cookie: line_nums=$form{'set_line'}; expires="
. toGMTString(time + 86400 * 152) . "; path=/\n";
}
print "\n";
# Some Globals
#
@src_roots = getRepositoryList();
# Init sanitiazation source checker
#
$sanitization_dictionary = $form{'sanitize'};
$opt_sanitize = defined $sanitization_dictionary;
if ( $opt_sanitize )
{
dbmopen %SourceChecker::token_dictionary, "$sanitization_dictionary", 0664;
}
# Init byrd's 'feature' to allow html in comments
#
$opt_html_comments = &html_comments_init();
# Handle the "file" argument
#
$filename = '';
$filename = $form{'file'} if defined($form{'file'});
if ($filename eq '')
{
&print_usage;
exit;
}
($file_head, $file_tail) = $filename =~ m@(.*/)?(.+)@;
# Handle the "rev" argument
#
$opt_rev = $form{'rev'} if defined($form{'rev'} && $form{'rev'} ne 'HEAD');
$browse_revtag = "HEAD";
$browse_revtag = $opt_rev if ($opt_rev =~ /[A-Za-z]/);
$revision = '';
# Handle the "root" argument
#
if (defined($root = $form{'root'}) && $root ne '') {
$root =~ s|/$||;
validateRepository($root);
if (-d $root) {
unshift(@src_roots, $root);
} else {
&print_top;
print "Error: Root, $root, is not a directory.<BR><BR>\n";
print "</BODY></HTML>\n";
&print_bottom;
exit;
}
}
# Find the rcs file
#
foreach (@src_roots) {
$root = $_;
$rcs_filename = "$root/$filename,v";
goto found_file if -r $rcs_filename;
$rcs_filename = "$root/${file_head}Attic/$file_tail,v";
goto found_file if -r $rcs_filename;
}
# File not found
&print_top;
print "Rcs file, $filename, does not exist.<BR><BR>\n";
print "</BODY></HTML>\n";
&print_bottom;
exit;
found_file:
($rcs_path) = $rcs_filename =~ m@$root/(.*)/.+?,v@;
# Parse the rcs file ($opt_rev is passed as a global)
#
$revision = &parse_cvs_file($rcs_filename);
$file_rev = $revision;
# Handle the "line_nums" argument
#
$opt_line_nums = 0;
$opt_line_nums = 1 if $cookie_jar{'line_nums'} eq 'on';
$opt_line_nums = 0 if $form{'line_nums'} =~ /off|no|0/i;
$opt_line_nums = 1 if $form{'line_nums'} =~ /on|yes|1/i;
# Option to make links to included files
$opt_includes = 0;
$opt_includes = 1 if $form{'includes'} =~ /on|yes|1/i;
$opt_includes = 1 if $opt_includes && $file_tail =~ /(.c|.h|.cpp)$/;
@text = &extract_revision($revision);
die "$progname: Internal consistency error" if ($#text != $#revision_map);
# Handle the "mark" argument
#
$mark_arg = '';
$mark_arg = $form{'mark'} if defined($form{'mark'});
foreach $mark (split(',',$mark_arg)) {
if (($begin, $end) = $mark =~ /(\d*)\-(\d*)/) {
$begin = 1 if $begin eq '';
$end = $#text + 1 if $end eq '' || $end > $#text + 1;
next if $begin >= $end;
$mark_line{$begin} = 'begin';
$mark_line{$end} = 'end';
} else {
$mark_line{$mark} = 'single';
}
}
# Start printing out the page
#
&print_top;
if ($ENV{'HTTP_USER_AGENT'} =~ /Win/) {
$font_tag = "<PRE><FONT FACE='Lucida Console' SIZE=-1>";
} else {
# We don't want your stinking Windows font
#$font_tag = "<FONT>";
$font_tag = "<PRE><FONT>";
}
# Print link at top for directory browsing
#
$output = "<DIV ALIGN=LEFT>";
foreach $path (split('/',$rcs_path)) {
$link_path .= $path;
$output .= "<A HREF='rview.cgi?dir=$link_path";
$output .= "&cvsroot=$form{'root'}" if defined $form{'root'};
$output .= "&rev=$browse_revtag" unless $browse_revtag eq 'HEAD';
$output .= "' onmouseover='window.status=\"Browse $link_path\";"
." return true;'>$path</A>/ ";
$link_path .= '/';
}
$output .= "$file_tail "
." (<A HREF onclick='return dif(\"$prev_revision{$revision}\",\"$revision\");'"
." onmouseover='return log(event,0,\"$prev_revision{$revision}\","
."\"$revision\");'>";
$output .= "$browse_revtag:" unless $browse_revtag eq 'HEAD';
$output .= $revision if $revision;
$output .= "</A>)";
$output .= "</DIV>";
EmitHtmlHeader("CVS Blame", $output);
print "<HR>\n";
print $font_tag;
# Print each line of the revision, preceded by its annotation.
#
$start_of_mark = 0;
$end_of_mark = 0;
$line_num_width = int(log($#revision_map)/log(10)) + 1;
$revision_width = 3;
$author_width = 5;
$line = 0;
$usedlog{$revision} = 1;
foreach $revision (@revision_map)
{
$text = $text[$line++];
$usedlog{$revision} = 1;
if ($opt_html_comments) {
# Don't escape HTML in C/C++ comments
$text = &leave_html_comments($text);
} elsif ( $opt_sanitize ){
# Mark filty words and Escape HTML meta-characters
$text = markup_line($text);
} else {
$text =~ s/&/&amp;/g;
$text =~ s/</&lt;/g;
$text =~ s/>/&gt;/g;
}
# Add a link to traverse to included files
$text = &link_includes($text) if $opt_includes;
$output = "<A NAME=$line></A>";
# Highlight lines
if (defined($mark_cmd = $mark_line{$line})
&& $mark_cmd ne 'end') {
$output .= "<TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0 "
."><TR><TD BGCOLOR=LIGHTGREEN WIDTH='100%'>$font_tag";
}
$output .= sprintf("%${line_num_width}s ", $line) if $opt_line_nums;
if ($old_revision ne $revision || $rev_count > 20) {
$author_width = max($author_width,length($revision_author{$revision}));
$revision_width = max($revision_width,length($revision));
$output .= ($rev_count > 20 ? '| ' : '+ ');
$output .= sprintf("%-${author_width}s ",$revision_author{$revision});
$output .= "<A HREF "
."onclick='return dif(\"$prev_revision{$revision}\",\"$revision\");' "
."onmouseover='return log(event,$line,\"$prev_revision{$revision}\","
."\"$revision\");'>$revision</A> ";
$output .= ' ' x ($revision_width - length($revision));
$old_revision = $revision;
$rev_count = 0;
} else {
$output .= '| ' . ' ' x ($author_width + $revision_width);
}
$rev_count++;
$output .= "$text";
# Close the highlighted section
if (defined($mark_cmd) && $mark_cmd ne 'begin') {
chop($output);
$output .= "</TD>";
#if( defined($prev_revision{$file_rev})) {
$output .= "<TD ALIGN=RIGHT><A HREF=\"cvsblame.cgi?file=$filename&rev=$prev_revision{$file_rev}&root=$root&mark=$mark_arg\">Previous&nbsp;Revision&nbsp;($prev_revision{$file_rev})</A></TD><TD BGCOLOR=LIGHTGREEN>&nbsp</TD>";
#}
$output .= "</TR></TABLE>";
}
print $output;
}
print "</FONT></PRE>\n";
# Write out cvs log messages as a JS variables
#
print "<SCRIPT>";
while (($revision, $junk) = each %usedlog) {
# Create a safe variable name for a revision log
$revisionName = $revision;
$revisionName =~ tr/./_/;
$log = $revision_log{$revision};
$log =~ s/([^\n\r]{80})([^\n\r]*)/$1\n$2/g;
eval ('$log =~ s@\d{4,6}@' . $BUGSYSTEMEXPR . '@g;');
$log =~ s/\n|\r|\r\n/<BR>/g;
$log =~ s/"/\\"/g;
# Write JavaScript variable for log entry (e.g. log1_1 = "New File")
print "log$revisionName = \""
."$revision_ctime{$revision}<BR>"
."<SPACER TYPE=VERTICAL SIZE=5>$log\";\n";
}
print "</SCRIPT>";
&print_bottom;
print "<NOLAYER><BR><FONT SIZE=-1>(This page is much cooler with a layers enabled browser)</FONT></NOLAYER>";
if ( $opt_sanitize )
{
dbmclose %SourceChecker::token_dictionary;
}
## END of main script
sub max {
local ($a, $b) = @_;
return ($a > $b ? $a : $b);
}
sub print_top {
local ($title_text) = "for $file_tail (";
$title_text .= "$browse_revtag:" unless $browse_revtag eq 'HEAD';
$title_text .= $revision if $revision;
$title_text .= ")";
$title_text =~ s/\(\)//;
local ($diff_dir_link) =
"cvsview2.cgi?subdir=$rcs_path&files=$file_tail&command=DIRECTORY";
$diff_dir_link .= "&root=$form{'root'}" if defined $form{'root'};
$diff_dir_link .= "&branch=$browse_revtag" unless $browse_revtag eq 'HEAD';
local ($diff_link) = "cvsview2.cgi?diff_mode=context&whitespace_mode=show";
$diff_link .= "&root=$form{'root'}" if defined $form{'root'};
$diff_link .= "&subdir=$rcs_path&command=DIFF_FRAMESET&file=$file_tail";
print <<__TOP__;
<HTML>
<HEAD>
<TITLE>CVS Blame $title_text</TITLE>
<SCRIPT>
document.loaded = false;
function revToName (rev) {
revName = rev + "";
revArray = revName.split(".");
return revArray.join("_");
}
function finishedLoad() {
if (parseInt(navigator.appVersion) < 4) {
return true;
}
document.loaded = true;
document.layers['popup'].visibility='hide';
return true;
}
function log(event, line, prev_rev, rev) {
window.defaultStatus = "";
if (prev_rev == '') {
window.status = "View diffs for " + file_tail;
} else {
window.status = "View diff for " + prev_rev + " vs." + rev;
}
if (parseInt(navigator.appVersion) < 4) {
return true;
}
l = document.layers['popup'];
if (document.loaded) {
l.document.write("<TABLE BORDER=1 CELLSPACING=1 CELLPADDING=2><TR><TD>");
if (line) {
l.document.write("line " + line + ", ");
}
l.document.write(eval("log" + revToName(rev)) + "</TD></TR></TABLE>");
l.document.close();
}
l.top = event.target.y - 3;
l.left = event.target.x + 40;
l.visibility="show";
return true;
}
function dif(prev_rev, rev) {
if (prev_rev == '') {
document.location = "$diff_dir_link";
} else {
document.location = "$diff_link"
+ "&rev1=" + prev_rev + "&rev2=" + rev;
}
return false;
}
file_tail = "$file_tail";
/* Make JavaScript happy in akbar */
event = 0;
initialLayer = "<TABLE BORDER=1 CELLSPACING=1 CELLPADDING=1><TR><TD><B>Page loading...please wait.</B></TD></TR></TABLE>";
</SCRIPT>
</HEAD>
<BODY onLoad="finishedLoad();">
<LAYER SRC="javascript:initialLayer" NAME='popup' onMouseOut="this.visibility='hide';" LEFT=0 TOP=0 BGCOLOR='#FFFFFF' VISIBILITY='hide'></LAYER>
__TOP__
} # print_top
sub print_usage {
local ($linenum_message) = '';
local ($new_linenum, $src_roots_list);
local ($title_text) = "Usage";
if ($ENV{"REQUEST_METHOD"} eq 'POST' && defined($form{'set_line'})) {
# Expire the cookie 5 months from now
$set_cookie = "Set-Cookie: line_nums=$form{'set_line'}; expires="
.&toGMTString(time + 86400 * 152)."; path=/";
}
if (!defined($cookie_jar{'line_nums'}) && !defined($form{'set_line'})) {
$new_linenum = 'on';
} elsif ($cookie_jar{'line_nums'} eq 'off' || $form{'set_line'} eq 'off') {
$linenum_message = 'Line numbers are currently <b>off</b>.';
$new_linenum = 'on';
} else {
$linenum_message = 'Line numbers are currently <b>on</b>.';
$new_linenum = 'off';
}
$src_roots_list = join('<BR>', @src_roots);
print <<__USAGE__;
<HTML>
<HEAD>
<TITLE>CVS Blame $title_text</TITLE>
</HEAD><BODY>
<H2>CVS Blame Usage</H2>
Add parameters to the query string to view a file.
<P>
<TABLE BORDER CELLPADDING=3>
<TR ALIGN=LEFT>
<TH>Param</TH>
<TH>Default</TH>
<TH>Example</TH>
<TH>Description</TH>
</TR><TR>
<TD>file</TD>
<TD>--</TD>
<TD>ns/cmd/Makefile</TD>
<TD>path to file name</TD>
</TR><TR>
<TD>root</TD>
<TD>$src_roots_list</TD>
<TD>/warp/webroot</TD>
<TD>cvs root</TD>
</TR><TR>
<TD>rev</TD>
<TD>HEAD</TD>
<TD>1.3
<BR>ACTRA_branch</TD>
<TD>revision</TD>
</TR><TR>
<TD>line_nums</TD>
<TD>off *</TD>
<TD>on
<BR>off</TD>
<TD>line numbers</TD>
</TR><TR>
<TD>#&lt;line_number&gt;</TD>
<TD>--</TD>
<TD>#111</TD>
<TD>jump to a line</TD>
</TR>
</TABLE>
<P>Examples:
<TABLE><TR><TD>&nbsp;</TD><TD>
<A HREF="cvsblame.cgi?file=ns/cmd/Makefile">
cvsblame.cgi?file=ns/cmd/Makefile</A>
</TD></TR><TR><TD>&nbsp;</TD><TD>
<A HREF="cvsblame.cgi?file=ns/cmd/xfe/mozilla.c&rev=Dogbert4xEscalation_BRANCH">
cvsblame.cgi?file=ns/cmd/xfe/mozilla.c&amp;rev=Dogbert4xEscalation_BRANCH</A>
</TD></TR><TR><TD>&nbsp;</TD><TD>
<A HREF="cvsblame.cgi?file=projects/bonsai/cvsblame.cgi&root=/warp/webroot">
cvsblame.cgi?file=projects/bonsai/cvsblame.cgi&root=/warp/webroot</A>
</TD></TR><TR><TD>&nbsp;</TD><TD>
<A HREF="cvsblame.cgi?file=ns/config/config.mk&line_nums=on">
cvsblame.cgi?file=ns/config/config.mk&amp;line_nums=on</A>
</TD></TR><TR><TD>&nbsp;</TD><TD>
<A HREF="cvsblame.cgi?file=ns/cmd/xfe/dialogs.c#2384">
cvsblame.cgi?file=ns/cmd/xfe/dialogs.c#2384</A>
</TD></TR></TABLE>
<P>
You may also begin a query with the <A HREF="cvsqueryform.cgi">CVS Query Form</A>.
<FORM METHOD='POST' ACTION='cvsblame.cgi'>
<TABLE CELLPADDING=0 CELLSPACING=0>
<TR>
<TD>*<SPACER TYPE=HORIZONTAL SIZE=6></TD>
<TD>Instead of the <i>line_nums</i> parameter, you can
<INPUT TYPE=submit value='set a cookie to turn $new_linenum'>
line numbers.</TD>
</TR><TR>
<TD></TD>
<TD>$linenum_message</TD>
</TR></TABLE>
<INPUT TYPE=hidden NAME='set_line' value='$new_linenum'>
</FORM>
__USAGE__
&print_bottom;
} # sub print_usage
sub print_bottom {
print <<__BOTTOM__;
<HR WIDTH="100%">
<FONT SIZE=-1>
<A HREF="cvsblame.cgi">Page configuration and help</A>.
Mail feedback to <A HREF="mailto:slamm?subject=About the cvsblame script">&lt;slamm\@netscape.com></A>.
</FONT></BODY>
</HTML>
__BOTTOM__
} # print_bottom
sub link_includes {
local ($text) = $_[0];
if ($text =~ /\#(\s*)include(\s*)"(.*?)"/) {
foreach $trial_root (($rcs_path, 'ns/include',
"$rcs_path/Attic", "$rcs_path/..")) {
if (-r "$root/$trial_root/$3,v") {
$text = "$`#$1include$2\"<A HREF='cvsblame.cgi"
."?root=$root&file=$trial_root/$3&rev=".$browse_revtag
."&use_html=$use_html'>$3</A>\";$'";
last;
}
}
}
return $text;
}
sub html_comments_init {
return 0 unless defined($form{'use_html'}) && $form{'use_html'};
# Initialization for C comment context switching
$in_comments = 0;
$open_delim = '\/\*';
$close_delim = '\*\/';
# Initialize the next expected delim
$expected_delim = $open_delim;
return 1;
}
sub leave_html_comments {
local ($text) = $_[0];
# Allow HTML in the comments.
#
$newtext = "";
$oldtext = $text;
while ($oldtext =~ /(.*$expected_delim)(.*\n)/) {
$a = $1;
$b = $2;
# pay no attention to C++ comments within C comment context
if ($in_comments == 0) {
$a =~ s/</&lt;/g;
$a =~ s/>/&gt;/g;
$expected_delim = $close_delim;
$in_comments = 1;
}
else {
$expected_delim = $open_delim;
$in_comments = 0;
}
$newtext = $newtext . $a;
$oldtext = $b;
}
# Handle thre remainder
if ($in_comments == 0){
$oldtext =~ s/</&lt;/g;
$oldtext =~ s/>/&gt;/g;
}
$text = $newtext . $oldtext;
# Now fix the breakage of <username> stuff on xfe. -byrd
if ($text =~ /(.*)<(.*@.*)>(.*\n)/) {
$text = $1 . "<A HREF=mailto:$2?subject=$filename>$2</A>" . $3;
}
return $text;
}

816
webtools/bonsai/cvsblame.pl Executable file
Просмотреть файл

@ -0,0 +1,816 @@
#!/usr/bonsaitools/bin/perl --
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Bonsai CVS tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
##############################################################################
#
# cvsblame.pl - Shamelessly adapted from Scott Furman's cvsblame script
# by Steve Lamm (slamm@netscape.com)
# - Annotate each line of a CVS file with its author,
# revision #, date, etc.
#
# Report problems to Steve Lamm (slamm@netscape.com)
#
##############################################################################
# $Id: cvsblame.pl,v 1.1 1998-06-16 21:42:56 terry Exp $
require 'timelocal.pl'; # timestamps
require 'ctime.pl'; # human-readable dates
$debug = 0;
# Extract base part of this script's name
($progname) = $0 =~ /([^\/]+)$/;
&cvsblame_init;
1;
sub cvsblame_init {
# Use default formatting options if none supplied
if (!$opt_A && !$opt_a && !$opt_d && !$opt_v) {
$opt_a = 1;
$opt_v = 1;
}
$time = time;
$SECS_PER_DAY = 60 * 60 * 24;
# Timestamp threshold at which annotations begin to occur, if -m option present.
$opt_m_timestamp = $time - $opt_m * $SECS_PER_DAY;
}
# Generic traversal of a CVS tree. Invoke callback function for
# individual directories that contain CVS files.
sub traverse_cvs_tree {
local ($dir, *callback, $nlink) = @_;
local ($dev, $ino, $mode, $subcount);
# Get $nlink for top-level directory
($dev, $ino, $mode, $nlink) = stat($dir) unless $nlink;
# Read directory
opendir(DIR, $dir) || die "Can't open $dir\n";
local(@filenames) = readdir(DIR);
closedir(DIR);
return if ! -d "$dir/CVS";
&callback($dir);
# This dir has subdirs
if ($nlink != 2) {
$subcount = $nlink - 2; # Number of subdirectories
for (@filenames) {
last if $subcount == 0;
next if $_ eq '.';
next if $_ eq '..';
next if $_ eq 'CVS';
$name = "$dir/$_";
($dev, $ino, $mode, $nlink) = lstat($name);
next unless -d _;
if (-x _ && -r _) {
print STDERR "$progname: Entering $name\n";
&traverse_cvs_tree($name, *callback, $nlink);
} else {
warn("Couldn't chdir to $name");
}
--$subcount;
}
}
}
# Consume one token from the already opened RCSFILE filehandle.
# Unescape string tokens, if necessary.
sub get_token {
# Erase all-whitespace lines.
while ($line_buffer =~ /^$/) {
die ("Unexpected EOF") if eof(RCSFILE);
$line_buffer = <RCSFILE>;
$line_buffer =~ s/^\s+//; # Erase leading whitespace
}
# A string of non-whitespace characters is a token ...
return $1 if ($line_buffer =~ s/^([^;@][^;\s]*)\s*//o);
# ...and so is a single semicolon ...
return ';' if ($line_buffer =~ s/^;\s*//o);
# ...or an RCS-encoded string that starts with an @ character.
$line_buffer =~ s/^@([^@]*)//o;
$token = $1;
# Detect single @ character used to close RCS-encoded string.
while ($line_buffer !~ /@/o || # Short-circuit optimization
$line_buffer !~ /([^@]|^)@([^@]|$)/o) {
$token .= $line_buffer;
die ("Unexpected EOF") if eof(RCSFILE);
$line_buffer = <RCSFILE>;
}
# Retain the remainder of the line after the terminating @ character.
$i = rindex($line_buffer, '@');
$token .= substr($line_buffer, 0, $i);
$line_buffer = substr($line_buffer, $i + 1);
# Undo escape-coding of @ characters.
$token =~ s/@@/@/og;
return $token;
}
# Consume a token from RCS filehandle and ensure that it matches
# the given string constant.
sub match_token {
local ($match) = @_;
local ($token) = &get_token;
die "Unexpected parsing error in RCS file $rcs_pathname.\n",
"Expected token: $match, but saw: $token\n"
if ($token ne $match);
}
# Push RCS token back into the input buffer.
sub unget_token {
local ($token) = @_;
$line_buffer = $token . " " . $line_buffer;
}
# Parses "administrative" header of RCS files, setting these globals:
#
# $head_revision -- Revision for which cleartext is stored
# $principal_branch
# $file_description
# %revision_symbolic_name -- mapping from numerical revision # to symbolic tag
# %tag_revision -- mapping from symbolic tag to numerical revision #
#
sub parse_rcs_admin {
local ($token, $tag, $tag_name, $tag_revision);
# Undefine variables, because we may have already read another RCS file
undef %tag_revision;
undef %revision_symbolic_name;
while (1) {
# Read initial token at beginning of line
$token = &get_token(RCSFILE);
# We're done once we reach the description of the RCS tree
if ($token =~ /^\d/o) {
&unget_token($token);
return;
}
# print "token: $token\n";
if ($token eq "head") {
$head_revision = &get_token;
&get_token; # Eat semicolon
} elsif ($token eq "branch") {
$principal_branch = &get_token;
&get_token; # Eat semicolon
} elsif ($token eq "symbols") {
# Create an associate array that maps from tag name to
# revision number and vice-versa.
while (($tag = &get_token) ne ';') {
($tag_name, $tag_revision) = split(':', $tag);
$tag_revision{$tag_name} = $tag_revision;
$revision_symbolic_name{$tag_revision} = $tag_name;
}
} elsif ($token eq "comment") {
$file_description = &get_token;
&get_token; # Eat semicolon
# Ignore all these other fields - We don't care about them.
} elsif (($token eq "locks") ||
($token eq "strict") ||
($token eq "expand") ||
($token eq "access")) {
(1) while (&get_token ne ';');
} else {
warn ("Unexpected RCS token: $token\n");
}
}
die "Unexpected EOF";
}
# Construct associative arrays that represent the topology of the RCS tree
# and other arrays that contain info about individual revisions.
#
# The following associative arrays are created, keyed by revision number:
# %revision_date -- e.g. "96.02.23.00.21.52"
# %timestamp -- seconds since 12:00 AM, Jan 1, 1970 GMT
# %revision_author -- e.g. "tom"
# %revision_branches -- descendant branch revisions, separated by spaces,
# e.g. "1.21.4.1 1.21.2.6.1"
# %prev_revision -- revision number of previous *ancestor* in RCS tree.
# Traversal of this array occurs in the direction
# of the primordial (1.1) revision.
# %prev_delta -- revision number of previous revision which forms the
# basis for the edit commands in this revision.
# This causes the tree to be traversed towards the
# trunk when on a branch, and towards the latest trunk
# revision when on the trunk.
# %next_delta -- revision number of next "delta". Inverts %prev_delta.
#
# Also creates %last_revision, keyed by a branch revision number, which
# indicates the latest revision on a given branch,
# e.g. $last_revision{"1.2.8"} == 1.2.8.5
#
sub parse_rcs_tree {
local($revision, $date, $author, $branches, $next);
local($branch, $is_trunk_revision);
local($mon,$day,$hhmm,$year);
# Undefine variables, because we may have already read another RCS file
undef %timestamp;
undef %revision_age;
undef %revision_author;
undef %revision_branches;
undef %revision_ctime;
undef %revision_date;
undef %prev_revision;
undef %prev_delta;
undef %next_delta;
undef %last_revision;
while (1) {
$revision = &get_token;
# End of RCS tree description ?
if ($revision eq 'desc') {
&unget_token($revision);
return;
}
$is_trunk_revision = ($revision =~ /^[0-9]+\.[0-9]+$/);
$tag_revision{$revision} = $revision;
($branch) = $revision =~ /(.*)\.[0-9]+/o;
$last_revision{$branch} = $revision;
# Parse date
&match_token('date');
$date = &get_token;
$revision_date{$revision} = $date;
&match_token(';');
# Convert date into timestamp
@date_fields = reverse(split(/\./, $date));
$date_fields[4]--; # Month ranges from 0-11, not 1-12
$timestamp{$revision} = &timegm(@date_fields);
# Compute date string; Format it the way I like.
($mon, $day, $hhmm, $year)
= &ctime($timestamp{$revision})
=~ /... (...) (..) (..:..):.. \S* (....)/;
$revision_ctime{$revision} = "$day $mon $year $hhmm";
# $revision_ctime{$revision} = &ctime($timestamp{$revision});
# Save age
$revision_age{$revision} =
($time - $timestamp{$revision}) / $SECS_PER_DAY;
# Parse author
&match_token('author');
$author = &get_token;
$revision_author{$revision} = $author;
&match_token(';');
# Parse state;
&match_token('state');
(1) while (&get_token ne ';');
# Parse branches
&match_token('branches');
$branches = '';
while (($token = &get_token) ne ';') {
$prev_revision{$token} = $revision;
$prev_delta{$token} = $revision;
$branches .= "$token ";
}
$revision_branches{$revision} = $branches;
# Parse revision of next delta in chain
&match_token('next');
$next = '';
if (($token = &get_token) ne ';') {
$next = $token;
&get_token; # Eat semicolon
$next_delta{$revision} = $next;
$prev_delta{$next} = $revision;
if ($is_trunk_revision) {
$prev_revision{$revision} = $next;
} else {
$prev_revision{$next} = $revision;
}
}
if ($debug >= 3) {
print "<pre>revision = $revision\n";
print "date = $date\n";
print "author = $author\n";
print "branches = $branches\n";
print "next = $next</pre>\n\n";
}
}
}
sub parse_rcs_description {
&match_token('desc');
$rcs_file_description = &get_token;
}
# Construct associative arrays containing info about individual revisions.
#
# The following associative arrays are created, keyed by revision number:
# %revision_log -- log message
# %revision_deltatext -- Either the complete text of the revision,
# in the case of the head revision, or the
# encoded delta between this revision and another.
# The delta is either with respect to the successor
# revision if this revision is on the trunk or
# relative to its immediate predecessor if this
# revision is on a branch.
sub parse_rcs_deltatext {
undef %revision_log;
undef %revision_deltatext;
while (!eof(RCSFILE)) {
$revision = &get_token;
print "Reading delta for revision: $revision\n" if ($debug >= 3);
&match_token('log');
$revision_log{$revision} = &get_token;
&match_token('text');
$revision_deltatext{$revision} = &get_token;
}
}
# Reads and parses complete RCS file from already-opened RCSFILE descriptor.
sub parse_rcs_file {
print "Reading RCS admin...\n" if ($debug >= 2);
&parse_rcs_admin();
print "Reading RCS revision tree topology...\n" if ($debug >= 2);
&parse_rcs_tree();
if( $debug >= 3 ){
print "<pre>Keys:\n\n";
for $i (keys %tag_revision ){
$k = $tag_revision{$i};
print "yoyuo $i: $k\n";
}
print "</pre>\n";
}
&parse_rcs_description();
print "Reading RCS revision deltas...\n" if ($debug >= 2);
&parse_rcs_deltatext();
print "Done reading RCS file...\n" if ($debug >= 2);
}
# Map a tag to a numerical revision number. The tag can be a symbolic
# branch tag, a symbolic revision tag, or an ordinary numerical
# revision number.
sub map_tag_to_revision {
local($tag_or_revision) = @_;
local ($revision) = $tag_revision{$tag_or_revision};
# Is this a branch tag, e.g. xxx.yyy.0.zzz
if ($revision =~ /(.*)\.0\.([0-9]+)/o) {
$branch = $1 . '.' . $2;
# Return latest revision on the branch, if any.
return $last_revision{$branch} if (defined($last_revision{$branch}));
return $1; # No revisions on branch - return branch point
} else {
return $revision;
}
}
# Construct an ordered list of ancestor revisions to the given
# revision, starting with the immediate ancestor and going back
# to the primordial revision (1.1).
#
# Note: The generated path does not traverse the tree the same way
# that the individual revision deltas do. In particular,
# the path traverses the tree "backwards" on branches.
sub ancestor_revisions {
local ($revision) = @_;
local (@ancestors);
$revision = $prev_revision{$revision};
while ($revision) {
push(@ancestors, $revision);
$revision = $prev_revision{$revision};
}
return @ancestors;
}
# Extract the given revision from the digested RCS file.
# (Essentially the equivalent of cvs up -rXXX)
sub extract_revision {
local ($revision) = @_;
local (@path);
# Compute path through tree of revision deltas to most recent trunk revision
while ($revision) {
push(@path, $revision);
$revision = $prev_delta{$revision};
}
@path = reverse(@path);
shift @path; # Get rid of head revision
# Get complete contents of head revision
local (@text) = split(/^/, $revision_deltatext{$head_revision});
# Iterate, applying deltas to previous revision
foreach $revision (@path) {
$adjust = 0;
@diffs = split(/^/, $revision_deltatext{$revision});
local ($lines_added) = 0;
local ($lines_removed) = 0;
foreach $command (@diffs) {
if ($add_lines_remaining > 0) {
# Insertion lines from a prior "a" command.
splice(@text, $start_line + $adjust,
0, $command);
$add_lines_remaining--;
$adjust++;
} elsif ($command =~ /^d(\d+)\s(\d+)/) {
# "d" - Delete command
($start_line, $count) = ($1, $2);
splice(@text, $start_line + $adjust - 1, $count);
$adjust -= $count;
$lines_removed += $count;
} elsif ($command =~ /^a(\d+)\s(\d+)/) {
# "a" - Add command
($start_line, $count) = ($1, $2);
$add_lines_remaining = $count;
$lines_added += $lines_added;
} else {
die "Error parsing diff commands";
}
}
$lines_removed{$revision} += $lines_removed;
$lines_added{$revision} += $lines_added;
}
return @text;
}
sub parse_cvs_file {
local($rcs_pathname) = @_;
# Args in: $opt_rev - requested revision
# $opt_m - time since modified
# Args out: @revision_map
# $revision
# %timestamp
# (%revision_deltatext)
@revision_map = ();
die "$progname: error: This file appeared to be under CVS control, " .
"but the RCS file is inaccessible.\n(Couldn't open '$rcs_pathname')\n"
if !open (RCSFILE, "< $rcs_pathname");
&parse_rcs_file();
close(RCSFILE);
if (!defined($opt_rev) || $opt_rev eq '' || $opt_rev eq 'HEAD') {
# Explicitly specified topmost revision in tree
$revision = $head_revision;
} else {
# Symbolic tag or specific revision number specified.
$revision = &map_tag_to_revision($opt_rev);
die "$progname: error: -r: No such revision: $opt_rev\n"
if ($revision eq '');
}
# The primordial revision is not always 1.1! Go find it.
my $primordial = $revision;
while ($prev_revision{$primordial} != "") {
$primordial = $prev_revision{$primordial};
}
# Don't display file at all, if -m option is specified and no
# changes have been made in the specified file.
return if ($opt_m && $timestamp{$revision} < $opt_m_timestamp);
# Figure out how many lines were in the primordial, i.e. version 1.1,
# check-in by moving backward in time from the head revision to the
# first revision.
$line_count = split(/^/, $revision_deltatext{$head_revision});
for ($rev = $prev_revision{$head_revision}; $rev;
$rev = $prev_revision{$rev}) {
@diffs = split(/^/, $revision_deltatext{$rev});
foreach $command (@diffs) {
if ($skip > 0) {
# Skip insertion lines from a prior "a" command.
$skip--;
} elsif ($command =~ /^d(\d+)\s(\d+)/) {
# "d" - Delete command
($start_line, $count) = ($1, $2);
$line_count -= $count;
} elsif ($command =~ /^a(\d+)\s(\d+)/) {
# "a" - Add command
($start_line, $count) = ($1, $2);
$skip = $count;
$line_count += $count;
} else {
die "$progname: error: illegal RCS file $rcs_pathname\n",
" error appears in revision $rev\n";
}
}
}
# Now, play the delta edit commands *backwards* from the primordial
# revision forward, but rather than applying the deltas to the text of
# each revision, apply the changes to an array of revision numbers.
# This creates a "revision map" -- an array where each element
# represents a line of text in the given revision but contains only
# the revision number in which the line was introduced rather than
# the line text itself.
#
# Note: These are backward deltas for revisions on the trunk and
# forward deltas for branch revisions.
# Create initial revision map for primordial version.
while ($line_count--) {
push(@revision_map, $primordial);
}
@ancestors = &ancestor_revisions($revision);
unshift (@ancestors, $revision); #
pop @ancestors; # Remove "1.1"
$last_revision = $primordial;
foreach $revision (reverse @ancestors) {
$is_trunk_revision = ($revision =~ /^[0-9]+\.[0-9]+$/);
if ($is_trunk_revision) {
@diffs = split(/^/, $revision_deltatext{$last_revision});
# Revisions on the trunk specify deltas that transform a
# revision into an earlier revision, so invert the translation
# of the 'diff' commands.
foreach $command (@diffs) {
if ($skip > 0) {
$skip--;
} else {
if ($command =~ /^d(\d+)\s(\d+)$/) { # Delete command
($start_line, $count) = ($1, $2);
$#temp = -1;
while ($count--) {
push(@temp, $revision);
}
splice(@revision_map, $start_line - 1, 0, @temp);
} elsif ($command =~ /^a(\d+)\s(\d+)$/) { # Add command
($start_line, $count) = ($1, $2);
splice(@revision_map, $start_line, $count);
$skip = $count;
} else {
die "Error parsing diff commands";
}
}
}
} else {
# Revisions on a branch are arranged backwards from those on
# the trunk. They specify deltas that transform a revision
# into a later revision.
$adjust = 0;
@diffs = split(/^/, $revision_deltatext{$revision});
foreach $command (@diffs) {
if ($skip > 0) {
$skip--;
} else {
if ($command =~ /^d(\d+)\s(\d+)$/) { # Delete command
($start_line, $count) = ($1, $2);
splice(@revision_map, $start_line + $adjust - 1, $count);
$adjust -= $count;
} elsif ($command =~ /^a(\d+)\s(\d+)$/) { # Add command
($start_line, $count) = ($1, $2);
$skip = $count;
$#temp = -1;
while ($count--) {
push(@temp, $revision);
}
splice(@revision_map, $start_line + $adjust, 0, @temp);
$adjust += $skip;
} else {
die "Error parsing diff commands";
}
}
}
}
$last_revision = $revision;
}
$revision;
}
__END__
#
# The following are parts of the original cvsblame script that are not
# used for cvsblame.pl
#
# Read CVS/Entries and CVS/Repository files.
#
# Creates these associative arrays, keyed by the CVS file pathname
#
# %cvs_revision -- Revision # present in working directory
# %cvs_date
# %cvs_sticky_revision -- Sticky tag, if any
#
# Also, creates %cvs_files, keyed by the directory path, which contains
# a space-separated list of the files under CVS control in the directory
sub read_cvs_entries
{
local ($directory) = @_;
local ($filename, $rev, $date, $idunno, $sticky, $pathname);
$cvsdir = $directory . '/CVS';
return if (! -d $cvsdir);
return if !open(ENTRIES, "< $cvsdir/Entries");
while(<ENTRIES>) {
chop;
($filename, $rev, $date, $idunno, $sticky) = split("/", substr($_, 1));
($pathname) = $directory . "/" . $filename;
$cvs_revision{$pathname} = $rev;
$cvs_date{$pathname} = $date;
$cvs_sticky_revision{$pathname} = $sticky;
$cvs_files{$directory} .= "$filename\\";
}
close(ENTRIES);
return if !open(REPOSITORY, "< $cvsdir/Repository");
$repository = <REPOSITORY>;
chop($repository);
close(REPOSITORY);
$repository{$directory} = $repository;
}
# Given path to file in CVS working directory, compute path to RCS
# repository file. Cache that info for future use.
sub rcs_pathname {
($pathname) = @_;
if ($pathname =~ m@/@) {
($directory,$filename) = $pathname =~ m@(.*)/([^/]+)$@;
} else {
($directory,$filename) = ('.',$pathname);
$pathname = "./" . $pathname;
}
if (!defined($repository{$directory})) {
&read_cvs_entries($directory);
}
if (!defined($cvs_revision{$pathname})) {
die "$progname: error: File '$pathname' does not appear to be under" .
" CVS control.\n"
}
print STDERR "file: $filename\n" if $debug;
local ($rcs_path) = $repository{$directory} . '/' . $filename . ',v';
return $rcs_path if (-r $rcs_path);
# A file that exists only on the branch, not on the trunk, is found
# in the Attic subdir.
return $repository{$directory} . '/Attic/' . $filename . ',v';
}
sub show_annotated_cvs_file {
local($pathname) = @_;
local(@output) = ();
$revision = &parse_cvs_file($pathname);
@text = &extract_revision($revision);
die "$progname: Internal consistency error" if ($#text != $#revision_map);
# Set total width of line annotation.
# Warning: field widths here must match format strings below.
$annotation_width = 0;
$annotation_width += 8 if $opt_a; # author
$annotation_width += 7 if $opt_v; # revision
$annotation_width += 6 if $opt_A; # age
$annotation_width += 12 if $opt_d; # date
$blank_annotation = ' ' x $annotation_width;
if ($multiple_files_on_command_line) {
print "\n", "=" x (83 + $annotation_width);
print "\n$progname: Listing file: $pathname\n"
}
# Print each line of the revision, preceded by its annotation.
$line = 0;
foreach $revision (@revision_map) {
$text = $text[$line++];
$annotation = '';
# Annotate with revision author
$annotation .= sprintf("%-8s", $revision_author{$revision}) if $opt_a;
# Annotate with revision number
$annotation .= sprintf(" %-6s", $revision) if $opt_v;
# Date annotation
$annotation .= " $revision_ctime{$revision}" if $opt_d;
# Age annotation ?
$annotation .= sprintf(" (%3s)",
int($revision_age{$revision})) if $opt_A;
# -m (if-modified-since) annotion ?
if ($opt_m && ($timestamp{$revision} < $opt_m_timestamp)) {
$annotation = $blank_annotation;
}
# Suppress annotation of whitespace lines, if requested;
$annotation = $blank_annotation if $opt_w && ($text =~ /^\s*$/);
# printf "%4d ", $line if $opt_l;
# print "$annotation - $text";
push(@output, sprintf("%4d ", $line)) if $opt_l;
push(@output, "$annotation - $text");
}
@output;
}
sub usage {
die
"$progname: usage: [options] [file|dir]...\n",
" Options:\n",
" -r <revision> Specify CVS revision of file to display\n",
" <revision> can be any of:\n",
" + numeric tag, e.g. 1.23,\n",
" + symbolic branch or revision tag, e.g. CHEDDAR,\n",
" + HEAD keyword (most recent revision on trunk)\n",
" -a Annotate lines with author (username)\n",
" -A Annotate lines with age, in days\n",
" -v Annotate lines with revision number\n",
" -d Annotate lines with date, in local time zone\n",
" -l Annotate lines with line number\n",
" -w Don't annotate all-whitespace lines\n",
" -m <# days> Only annotate lines modified within last <# days>\n",
" -h Print help (this message)\n\n",
" (-a -v assumed, if none of -a, -v, -A, -d supplied)\n"
;
}
&usage if (!&Getopts('r:m:Aadhlvw'));
&usage if ($opt_h); # help option
$multiple_files_on_command_line = 1 if ($#ARGV != 0);
&cvsblame_init;
sub annotate_cvs_directory
{
local($dir) = @_;
&read_cvs_entries($dir);
foreach $file (split(/\\/, $cvs_files{$dir})) {
&show_annotated_cvs_file("$dir/$file");
}
}
# No files on command-line ? Use current directory.
push(@ARGV, '.') if ($#ARGV == -1);
# Iterate over files/directories on command-line
while ($#ARGV >= 0) {
$pathname = shift @ARGV;
# Is it a directory ?
if (-d $pathname) {
&traverse_cvs_tree($pathname, *annotate_cvs_directory);
# No, it must be a file.
} else {
&show_annotated_cvs_file($pathname);
}
}

72
webtools/bonsai/cvsguess.cgi Executable file
Просмотреть файл

@ -0,0 +1,72 @@
#!/usr/bonsaitools/bin/perl --
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Bonsai CVS tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
require 'lloydcgi.pl';
require 'utils.pl';
$file= $form{'file'};
$mark= $form{'mark'};
$ln = ($mark > 10 ? $mark-10 : 1 );
$rev = $form{'rev'};
$debug = $form{'debug'};
print "Content-Type: text/html\n\n";
$CVS_ROOT = $form{'root'};
if( $CVS_ROOT eq '' ){
$CVS_ROOT = pickDefaultRepository();
}
validateRepository($CVS_ROOT);
$CVS_REPOS_SUFIX = $CVS_ROOT;
$CVS_REPOS_SUFIX =~ s/\//_/g;
$db = ConnectToDatabase();
$f = SqlQuote($file);
$qstring = "select distinct dirs.dir from checkins,dirs,files,repositories where dirs.id=dirid and files.id=fileid and repositories.id=repositoryid and repositories.repository='$CVS_ROOT' and files.file='$f' order by dirs.dir";
if ($debug) {
print "<pre wrap>$qstring</pre>\n";
}
$query = $db->Query($qstring) || die $Mysql::db_errstr;
while(@row = $query->fetchrow){
$d = $row[0];
push @fl, "$d/$file";
}
if( @fl == 0 ){
print "<h3>No files matched this file name. It may have been added recently.</h3>";
}
elsif( @fl == 1 ){
$s = $fl[0];
print "<head>
<meta http-equiv=Refresh
content=\"0; URL=cvsblame.cgi?file=$s&rev=$rev&root=$CVS_ROOT&mark=$mark#$ln\">
</head>
";
}
else {
print "<h3>Pick the file that best matches the one you are looking for:</h3>\n";
for $s (@fl) {
print "<dt><a href=cvsblame.cgi?file=$s&rev=$rev&mark=$mark#$ln>$s</a>";
}
}

91
webtools/bonsai/cvsindex.pl Executable file
Просмотреть файл

@ -0,0 +1,91 @@
#!/usr/bonsaitools/bin/perl --
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Bonsai CVS tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
# Figure out which directory bonsai is in by looking at argv[0]
$bonsaidir = $0;
$bonsaidir =~ s:/[^/]*$::; # Remove last word, and slash before it.
if ($bonsaidir eq "") {
$bonsaidir = ".";
}
chdir $bonsaidir || die "Couldn't chdir to $bonsaidir";
require "utils.pl";
if( $ARGV[0] eq '' ){
$CVS_ROOT = pickDefaultRepository();
}
else {
$CVS_ROOT = $ARGV[0];
}
$CVS_REPOS_SUFIX = $CVS_ROOT;
$CVS_REPOS_SUFIX =~ s:/:_:g;
$CHECKIN_DATA_FILE = "$bonsaidir/data/checkinlog${CVS_REPOS_SUFIX}";
$CHECKIN_INDEX_FILE = "$bonsaidir/data/index${CVS_REPOS_SUFIX}";
&build_index;
&print_keys;
sub build_index {
open(CI, "<$CHECKIN_DATA_FILE") || die "could not open checkin data file\n";
$file_pos = 0;
$lastlog = 0;
$last_date = 0;
$index = {};
$now = time;
while( <CI> ){
if( /^LOGCOMMENT/ ){
$done = 0;
$file_pos += length;
while( !$done && ($line = <CI>) ){
if( $line =~ /^:ENDLOGCOMMENT/ ){
$done = 1;
}
$file_pos += length($line);
}
}
else {
#print $_ . "\n";
$ci = [split(/\|/)];
$d = $ci->[1];
if( $d < $now && $d > ($last_date + 60*60*4) ){
$index->{$d} = $file_pos;
$last_date = $d;
}
$file_pos += length;
}
}
close( CI );
}
sub print_keys {
Lock();
open(INDEX , ">$CHECKIN_INDEX_FILE");
for $i (sort {$b <=> $a} keys %{$index}) {
print INDEX "$index->{$i}|$i\n";
}
close(INDEX);
Unlock();
}

493
webtools/bonsai/cvslog.cgi Executable file
Просмотреть файл

@ -0,0 +1,493 @@
#!/usr/bonsaitools/bin/perl --
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Bonsai CVS tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
# cvslog.cgi -- cvslog with logs as popups and allowing html in comments.
#
# Created: Steve Lamm <slamm@netscape.com>, 31-Mar-98.
#
# Arguments (passed via GET or POST):
# file - path to file name (e.g. ns/cmd/xfe/Makefile)
# root - cvs root (e.g. /warp/webroot)
# rev - revision (default is the latest version)
# mark - highlight a revision
# author - filter based on author
#
require 'lloydcgi.pl';
require 'cvsblame.pl';
require 'utils.pl';
use SourceChecker;
# Some Globals
#
$| = 1;
print "Content-Type:text/html\n\n";
@src_roots = getRepositoryList();
# Handle the "file" argument
#
$filename = '';
$filename = $form{'file'} if defined($form{'file'});
if ($filename eq '')
{
&print_usage;
exit;
}
($file_head, $file_tail) = $filename =~ m@(.*/)?(.+)@;
# Handle the "rev" argument
#
$opt_rev = $form{'rev'} if defined($form{'rev'} && $form{'rev'} ne 'HEAD');
$browse_revtag = 'HEAD';
$browse_revtag = $opt_rev if ($opt_rev =~ /[A-Za-z]/);
$revision = '';
# Handle the "root" argument
#
if (defined($root = $form{'root'}) && $root ne '') {
$root =~ s|/$||;
validateRepository($root);
if (-d $root) {
unshift(@src_roots, $root);
} else {
&print_top;
print "Error: Root, $root, is not a directory.<BR><BR>\n";
print "</BODY></HTML>\n";
&print_bottom;
exit;
}
}
# Find the rcs file
#
foreach (@src_roots) {
$root = $_;
$rcs_filename = "$root/$filename,v";
goto found_file if -r $rcs_filename;
$rcs_filename = "$root/${file_head}Attic/$file_tail,v";
goto found_file if -r $rcs_filename;
}
# File not found
&print_top;
print "Rcs file, $filename, does not exist.<BR><BR>\n";
print "</BODY></HTML>\n";
&print_bottom;
exit;
found_file:
($rcs_path) = $rcs_filename =~ m@$root/(.*)/.+?,v@;
# Parse the rcs file ($opt_rev is passed as a global)
#
$revision = &parse_cvs_file($rcs_filename);
$file_rev = $revision;
# Handle the "mark" argument
#
$mark_arg = '';
$mark_arg = $form{'mark'} if defined($form{'mark'});
foreach $rev (split(',',$mark_arg)) {
$mark{$rev} = 1;
}
# Handle the "author" argument
#
$author_arg = '';
$author_arg = $form{'author'} if defined($form{'author'});
foreach $author (split(',',$author_arg)) {
$use_author{$author} = 1;
}
# Handle the "sort" argument
$opt_sort = '';
$opt_sort = $form{'sort'};
# Start printing out the page
#
&print_top;
if ($ENV{'HTTP_USER_AGENT'} =~ /Win/) {
$font_tag = "<FONT FACE='Lucida Console' SIZE=-1>";
} else {
# We don't want your stinking Windows font
$font_tag = "<FONT>";
}
# Print link at top for directory browsing
#
$output = "<DIV ALIGN=LEFT>";
foreach $path (split('/',$rcs_path)) {
$link_path .= $path;
$output .= "<A HREF='rview.cgi?dir=$link_path";
$output .= "&cvsroot=$form{'root'}" if defined $form{'root'};
$output .= "&rev=$browse_revtag" unless $browse_revtag eq 'HEAD';
$output .= "' onmouseover='window.status=\"Browse $link_path\";"
." return true;'>$path</A>/ ";
$link_path .= '/';
}
$output .= "$file_tail (";
$output .= "$browse_revtag:" unless $browse_revtag eq 'HEAD';
$output .= $revision if $revision;
$output .= ")";
EmitHtmlHeader("CVS Log", $output);
&print_useful_links($filename);
# Create a table with header links to sort by column.
#
$table_tag = "<TABLE BORDER=0 CELLSPACING=0 CELLPADDING=3 WIDTH='100%'>";
if ($opt_sort eq 'author') {
$table_header_tag .= "<TH ALIGN=LEFT><A HREF='cvslog.cgi?file=$filename&root=$root&rev=$browse_revtag&sort=revision&author=$author_arg'>Rev</A><TH ALIGN=LEFT>Author<TH ALIGN=LEFT><A HREF='cvslog.cgi?file=$filename&root=$root&rev=$browse_revtag&sort=date&author=$author_arg'>Date</A><TH><TH ALIGN=LEFT>Log";
} else {
$table_header_tag .= "<TH ALIGN=LEFT>Rev<TH ALIGN=LEFT><A HREF='cvslog.cgi?file=$filename&root=$root&rev=$browse_revtag&sort=author&author=$author_arg'>Author</A><TH ALIGN=LEFT>Date<TH><TH ALIGN=LEFT>Log";
}
print "$font_tag$table_tag$table_header_tag";
# Print each line of the revision, preceded by its annotation.
#
if ($browse_revtag eq 'HEAD') {
$start_rev = $head_revision; # $head_revision is a global from cvsblame.pl
} else {
$start_rev = map_tag_to_revision($browse_revtag);
}
$row_count = 0;
$max_rev_length = length($start_rev);
$max_author_length = 8;
@revisions = ($start_rev, ancestor_revisions($start_rev));
@revisions = sort by_author @revisions if $opt_sort eq 'author';
#@revisions = sort by_author @revisions if $opt_sort eq 'date' && $rev eq 'all';
foreach $revision (@revisions)
{
$author = $revision_author{$revision};
next unless $author_arg eq '' || $use_author{$author};
$log = $revision_log{$revision};
$log =~ s/&/&amp;/g;
$log =~ s/</&lt;/g;
$log =~ s/>/&gt;/g;
eval ('$log =~ s@\d{4,6}@' . $BUGSYSTEMEXPR . '@g;');
$log =~ s/\n|\r|\r\n/<BR>/g;
if ($bgcolor eq '') {
#$bgcolor = ' BGCOLOR="#EEEEEE"';# My browser translates this to white.
$bgcolor = ' BGCOLOR="#E7E7E7"'; # Pick a grey that shows up on 8-bit.
} else {
$bgcolor = '';
}
$output = '';
$row_count++;
if ($row_count > 20) {
$output .= "</TABLE>\n$table_tag";
$row_count = 0;
}
$output .= "<TR$bgcolor VALIGN=TOP><TD>"
."<A NAME=$revision><A HREF='cvsview2.cgi";
if (defined($prev_revision{$revision})) {
$output .= "?diff_mode=context&whitespace_mode=show&file=$file_tail"
."&root=$root&subdir=$rcs_path&command=DIFF_FRAMESET"
."&rev1=$prev_revision{$revision}&rev2=$revision";
} else {
$output .= "?files=$file_tail"
."&root=$root&subdir=$rcs_path\&command=DIRECTORY\&rev2=$revision";
$output .= "&branch=$browse_revtag" unless $browse_revtag eq 'HEAD';
}
$output .= "'>$revision</A>"
.'&nbsp' x ($max_rev_length - length($revision)).'</TD>';
$output .= "<TD>".$author
.'&nbsp' x ($max_author_length - length($author)).'</TD>';
$rev_time = $revision_ctime{$revision};
# $rev_time =~ s/(19\d\d) (.\d:\d\d)/$1<BR><FONT SIZE=-2>$2<\/FONT>/;
# jwz: print the date the way "ls" does.
#
# What ls does is actually: print "Mmm DD HH:MM" unless the file is
# more than six months old, or more than 1 hour in the future, in
# which case, print "Mmm DD YYYY".
#
# What the following does is: "Mmm DD HH:MM" unless the year is not
# the current year; else print "Mmm DD YYYY".
#
# If we had $rev_time as an actual time_t instead of as a string,
# it would be easy to do the "ls" thing (see the code I wrote for
# this in "lxr/source"). -jwz, 15-Jun-98.
#
{
my $current_time = time;
my @t = gmtime($current_time);
my ($csec, $cmin, $chour, $cmday, $cmon, $cyear) = @t;
$cyear += 1900;
$_ = $rev_time;
my ($rday, $rmon, $ryear, $rhour, $rmin) =
m/([0-9]+) ([A-Z][a-z]+) ([0-9][0-9]+) +([0-9]+):([0-9]+)/;
$rmon =~ s/^(...).*$/$1/;
if (!$rday) {
# parse error -- be annoying so somebody complains.
$rev_time = "<BLINK>\"$rev_time\"</BLINK>";
} elsif ($cyear ne $ryear) {
$rev_time = sprintf("%s %2d %04d", $rmon, $rday, $ryear);
} else {
$rev_time = sprintf("%s %2d %02d:%02d",
$rmon, $rday, $rhour, $rmin);
}
$rev_time = "<FONT SIZE=\"-1\">$rev_time</FONT>";
}
$output .= "<TD NOWRAP ALIGN=RIGHT>$rev_time</TD>";
$output .= "<TD>&nbsp;</TD><TD WIDTH=99%>$log</TD>";
$output .= "</TR>\n";
print $output;
}
print "</TABLE>";
&print_bottom;
## END of main script
sub by_revision {
local (@a_parts) = split(/\./,$a);
local (@b_parts) = split(/\./,$b);
while(1) {
local ($aa) = shift @a_parts;
local ($bb) = shift @b_parts;
return 1 if $aa eq '';
return -1 if $bb eq '';
return $bb <=> $aa if $aa ne $bb;
}
}
sub by_author {
local ($a_author) = $revision_author{$a};
local ($b_author) = $revision_author{$b};
return $a_author cmp $b_author if $a_author ne $b_author;
return by_revision;
}
sub revision_pad {
local ($revision) = @_;
return '&nbsp' x ($max_rev_length - length($revision));
}
sub sprint_author {
local ($revision) = @_;
local ($author) = $revision_author{$revision};
return
}
sub print_top {
local ($title_text) = "for $file_tail (";
$title_text .= "$browse_revtag:" unless $browse_revtag eq 'HEAD';
$title_text .= $revision if $revision;
$title_text .= ")";
$title_text =~ s/\(\)//;
print <<__TOP__;
<HTML>
<HEAD>
<TITLE>CVS Log $title_text</TITLE>
<SCRIPT>
var event = new Object;
function who_menu(n,extra,d) {
if( parseInt(navigator.appVersion) < 4 ){
return true;
}
l = document.layers['popup'];
l.src="../registry/who.cgi?email="+n+extra;
l.top = d.target.y - 6;
l.left = d.target.x - 6;
l.visibility="show";
return false;
}
function file_menu(dir,file,prev_rev,rev,root,d) {
if( parseInt(navigator.appVersion) < 4 ){
return true;
}
l = document.layers['popup'];
l.src="../registry/file.cgi?file="+file+"&dir="+dir+"&prev_rev="+prev_rev+"&rev="+rev+"&cvsroot="+root+"&linked_text="+rev;
/* d.target.text */
l.top = d.target.y - 6;
l.left = d.target.x - 6;
l.visibility="show";
return false;
}
</SCRIPT>
</HEAD>
<BODY BGCOLOR=WHITE TEXT=BLACK>
<layer name="popup" onMouseOut="this.visibility='hide';" left=0 top=0 bgcolor="#ffffff" visibility="hide">
</layer>
__TOP__
} # print_top
sub print_usage {
local ($linenum_message) = '';
local ($new_linenum, $src_roots_list);
local ($title_text) = "Usage";
$src_roots_list = join('<BR>', @src_roots);
print <<__USAGE__;
<HTML>
<HEAD>
<TITLE>CVS Log $title_text</TITLE>
</HEAD><BODY>
<H2>CVS Log Usage</H2>
Add parameters to the query string to view a file.
<P>
<TABLE BORDER CELLPADDING=3>
<TR ALIGN=LEFT>
<TH>Param</TH>
<TH>Default</TH>
<TH>Example</TH>
<TH>Description</TH>
</TR><TR>
<TD>file</TD>
<TD>--</TD>
<TD>ns/cmd/Makefile</TD>
<TD>Path to file name</TD>
</TR><TR>
<TD>root</TD>
<TD>$src_roots_list</TD>
<TD>/warp/webroot</TD>
<TD>CVS root</TD>
</TR><TR>
<TD>rev</TD>
<TD>HEAD</TD>
<TD>1.3
<BR>ACTRA_branch</TD>
<TD>Revision</TD>
</TR><TR>
<TD>author</TD>
<TD>--</TD>
<TD>slamm,mtoy</TD>
<TD>Filter out these authors</TD>
</TR>
</TR><TR>
<TD>#&lt;rev_number&gt;</TD>
<TD>--</TD>
<TD>#1.2</TD>
<TD>Jump to a revision</TD>
</TR>
</TABLE>
<P>Examples:
<TABLE><TR><TD>&nbsp;</TD><TD>
<A HREF="cvslog.cgi?file=ns/cmd/Makefile">
cvslog.cgi?file=ns/cmd/Makefile</A>
</TD></TR><TR><TD>&nbsp;</TD><TD>
<A HREF="cvslog.cgi?file=ns/cmd/xfe/mozilla.c&rev=Dogbert4xEscalation_BRANCH">
cvslog.cgi?file=ns/cmd/xfe/mozilla.c&amp;rev=Dogbert4xEscalation_BRANCH</A>
</TD></TR><TR><TD>&nbsp;</TD><TD>
<A HREF="cvslog.cgi?file=projects/bonsai/cvslog.cgi&root=/warp/webroot">
cvslog.cgi?file=projects/bonsai/cvslog.cgi&root=/warp/webroot</A>
</TD></TR><TR><TD>&nbsp;</TD><TD>
<A HREF="cvslog.cgi?file=ns/cmd/xfe/dialogs.c#1.19">
cvslog.cgi?file=ns/cmd/xfe/dialogs.c#1.19</A>
</TD></TR></TABLE>
<P>
You may also begin a query with the <A HREF="cvsqueryform.cgi">CVS Query Form</A>.
</P>
__USAGE__
&print_bottom;
} # sub print_usage
sub print_bottom {
print <<__BOTTOM__;
<HR WIDTH="100%">
<FONT SIZE=-1>
<A HREF="cvslog.cgi">Page configuration and help</A>.
Mail feedback to <A HREF="mailto:slamm\@netscape.com?subject=About the cvslog script">&lt;slamm\@netscape.com></A>.
</FONT></BODY>
</HTML>
__BOTTOM__
} # print_bottom
sub print_useful_links {
my ($path) = @_;
my ($dir, $file) = $path =~ m@(.*/)?(.+)@;
$dir =~ s@/$@@;
my $lxr_base = "http://cvs-mirror.mozilla.org/webtools/lxr/source";
my $diff_base = "cvsview2.cgi";
my $blame_base = "cvsblame.cgi";
# total kludge!! lxr omits the top-level "mozilla" directory...
my $lxr_path = $path;
$lxr_path =~ s@^ns/@@;
$lxr_path =~ s@^mozilla/@@;
my $lxr_link = "$lxr_base/$lxr_path";
my $diff_link = "$diff_base?command=DIRECTORY\&subdir=$dir\&files=$file";
my $blame_link = "$blame_base?root=$CVS_ROOT\&file=$path";
print "<DIV ALIGN=RIGHT>
<TABLE BORDER CELLPADDING=10 CELLSPACING=0>
<TR>
<TD>
<TABLE BORDER=0 CELLPADDING=1 CELLSPACING=0>
<TR>
<TD VALIGN=TOP ALIGN=RIGHT><A HREF=\"$lxr_link\"><B>lxr:</B></A> </TD>
<TD>browse the source code as hypertext.</TD>
</TR>
<TR>
<TD VALIGN=TOP ALIGN=RIGHT><A HREF=\"$diff_link\"><B>diff:</B></A> </TD>
<TD>compare any two versions.</TD>
</TR>
<TR>
<TD VALIGN=TOP ALIGN=RIGHT><A HREF=\"$blame_link\"><B>blame:</B></A> </TD>
<TD>annotate the author of each line.</TD>
</TR>
</TABLE>
</TD>
</TR>
</TABLE>
</DIV>
";
}

64
webtools/bonsai/cvsmenu.pl Normal file
Просмотреть файл

@ -0,0 +1,64 @@
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Bonsai CVS tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
1;
require 'utils.pl';
sub cvsmenu {
my($extra) = @_;
loadConfigData();
print "
<table border=1 bgcolor=#ffffcc $extra><tr><th>Menu</tr><tr><td>
<p><dl>";
my $pass;
my $i;
foreach $pass ("cvsqueryform|Query",
"rview|Browse",
"moduleanalyse|Examine Modules") {
($page, $title) = split(/\|/, $pass);
print "<b>$title</b><br><ul>\n";
foreach $i (@treelist) {
my $branch = $treeinfo{$i}->{'branch'};
if ($branch ne "") {
$branch = "&branch=" . $branch;
}
$desc = $treeinfo{$i}->{'shortdesc'};
if ($desc eq "") {
$desc = $treeinfo{$i}->{'description'};
}
print "<li><a href=$page.cgi?cvsroot=$treeinfo{$i}->{'repository'}&module=$treeinfo{$i}->{'module'}$branch>$desc</a>\n";
};
print "</ul>\n";
};
if (open(EXTRA, "<data/cvsmenuextra")) {
while (<EXTRA>) {
print $_;
}
close EXTRA;
}
print "</dl>
<p></tr><tr><td><font size=-1> Questions, Comments, Feature requests? mail <a href=mailto:terry\@netscape.com>terry</a>
</tr></table>
";
}

647
webtools/bonsai/cvsquery.cgi Executable file
Просмотреть файл

@ -0,0 +1,647 @@
#!/usr/bonsaitools/bin/perl --
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Bonsai CVS tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
require 'lloydcgi.pl';
require 'utils.pl';
use Date::Parse;
loadConfigData();
$CVS_ROOT = $form{"cvsroot"};
require 'timelocal.pl';
require 'cvsquery.pl';
$| = 1;
$sm_font_tag = "<font face='Arial,Helvetica' size=-2>";
print "Content-type: text/html
";
$script_str='';
&setup_script;
print "$script_str";
#print "<pre>";
$CVS_REPOS_SUFIX = $CVS_ROOT;
$CVS_REPOS_SUFIX =~ s/\//_/g;
$CHECKIN_DATA_FILE = "data/checkinlog${CVS_REPOS_SUFIX}";
$CHECKIN_INDEX_FILE = "data/index${CVS_REPOS_SUFIX}";
$SORT_HEAD="bgcolor=\"#DDDDDD\"";
#
# Log the query
open( LOG, ">>data/querylog.txt");
$t = time;
print LOG "$ENV{'REMOTE_ADDR'} $t $ENV{'QUERY_STRING'}\n";
close(LOG);
#
# build a module map
#
$query_module = $form{'module'};
#
# allow ?file=/a/b/c/foo.c to be synonymous with ?dir=/a/b/c&file=foo.c
#
if ( $form{'dir'} eq '' ) {
my ( $d, $f ) = $form{'file'} =~ m@(.*?/)([^/]*)$@;
$form{'dir'} = $d;
$form{'file'} = $f;
}
#
# build a directory map
#
@query_dirs = split(/[;, \t]+/, $form{'dir'});
$query_file = $form{'file'};
$query_filetype = $form{'filetype'};
$query_logexpr = $form{'logexpr'};
#
# date
#
$query_date_type = $form{'date'};
if( $query_date_type eq 'hours' ){
$query_date_min = time - $form{'hours'}*60*60;
}
elsif( $query_date_type eq 'day' ){
$query_date_min = time - 24*60*60;
}
elsif( $query_date_type eq 'week' ){
$query_date_min = time - 7*24*60*60;
}
elsif( $query_date_type eq 'month' ){
$query_date_min = time - 30*24*60*60;
}
elsif( $query_date_type eq 'all' ){
$query_date_min = 0;
}
elsif( $query_date_type eq 'explicit' ){
if ($form{'mindate'} ne "") {
$query_date_min = parse_date($form{'mindate'});
}
if ($form{'maxdate'} ne "") {
$query_date_max = parse_date($form{'maxdate'});
}
}
else {
$query_date_min = time-60*60*2;
}
#
# who
#
$query_who = $form{'who'};
$query_whotype = $form{'whotype'};
$show_raw = $form{'raw'} ne '';
#
# branch
#
$query_branch = $form{'branch'};
$query_branchtype = $form{'branchtype'};
#
# tags
#
$query_begin_tag = $form{'begin_tag'};
$query_end_tag = $form{'end_tag'};
#
# Get the query in english and print it.
#
$t = $e = &query_to_english;
$t =~ s/<[^>]*>//g;
$query_debug = $form{'debug'};
$result= &query_checkins( $mod_map );
for $i (@{$result}) {
$w{"$i->[$CI_WHO]\@netscape.com"} = 1;
}
@p = sort keys %w;
$pCount = @p;
$s = join(",%20", @p);
$e =~ s/Checkins in/In/;
my $menu = "
<p align=center>$e
<p align=left>
<a href=cvsqueryform.cgi?$ENV{QUERY_STRING}>Modify Query</a>
<br><a href=mailto:$s>Mail everyone on this page</a>
<NOBR>($pCount people)</NOBR>
";
EmitHtmlTitleAndHeader($t, "CVS Checkins", "$menu");
#
# Test code to print the results
#
$|=1;
if( !$show_raw ) {
if( $form{"sortby"} eq "Who" ){
$result = [sort {
$a->[$CI_WHO] cmp $b->[$CI_WHO]
|| $b->[$CI_DATE] <=> $a->[$CI_DATE]
} @{$result}] ;
$head_who = $SORT_HEAD;
}
elsif( $form{"sortby"} eq "File" ){
$result = [sort {
$a->[$CI_FILE] cmp $b->[$CI_FILE]
|| $b->[$CI_DATE] <=> $a->[$CI_DATE]
|| $a->[$CI_DIRECTORY] cmp $b->[$CI_DIRECTORY]
} @{$result}] ;
$head_file = $SORT_HEAD;
}
elsif( $form{"sortby"} eq "Directory" ){
$result = [sort {
$a->[$CI_DIRECTORY] cmp $b->[$CI_DIRECTORY]
|| $a->[$CI_FILE] cmp $b->[$CI_FILE]
|| $b->[$CI_DATE] <=> $a->[$CI_DATE]
} @{$result}] ;
$head_directory = $SORT_HEAD;
}
elsif( $form{"sortby"} eq "Change Size" ){
$result = [sort {
($b->[$CI_LINES_ADDED]- $b->[$CI_LINES_REMOVED])
<=> ($a->[$CI_LINES_ADDED]- $a->[$CI_LINES_REMOVED])
#|| $b->[$CI_DATE] <=> $a->[$CI_DATE]
} @{$result}] ;
$head_delta = $SORT_HEAD;
}
else{
$result = [sort {$b->[$CI_DATE] <=> $a->[$CI_DATE]} @{$result}] ;
$head_date = $SORT_HEAD;
}
&print_result($result);
}
else {
print "<pre>";
for $ci (@$result) {
$ci->[$CI_LOG] = '';
$s = join("|",@$ci);
print "$s\n";
}
}
#
# code to debug the modules_map
#
#print "<PRE>\n";
#while( ($k,$v) = each(%{$mod_map})) {
# print "$k=$v\n";
#}
#
#
#
sub print_tcl {
local($result) = @_;
local($t, $count,$first,$i, $k, $files);
$t = time;
print TCLOUT "set treeopen 0\n" .
"set lastgoodtimestamp $t\n" .
"set closetimestamp $t\n";
$count = 0;
$first = 0;
$i = 1;
$max = @{$result}+1;
while( $i < $max ){
$c1 = $result->[$first];
$c2 = $result->[$i];
if( $i == $max-1
|| $c1->[$CI_DATE] != $c2->[$CI_DATE]
|| $c1->[$CI_DIR] ne $c2->[$CI_DIR]
|| $c1->[$CI_WHO] ne $c2->[$CI_WHO]
) {
$files = '{';
$fu = '{';
$k = $first;
while( $k < $i ){
$files .= $result->[$k][$CI_FILE] . " ";
$fu .= &make_fullinfo( $result->[$k] );
$k++;
}
$files .= '}';
$fu .= '}';
print TCLOUT "set ci-${count}(date) $c1->[$CI_DATE]\n" .
"set ci-${count}(dir) $c1->[$CI_DIR]\n" .
"set ci-${count}(person) $c1->[$CI_WHO]\n" .
"set ci-${count}(files) $files\n" .
"set ci-${count}(fullinfo) $fu\n" .
"set ci-${count}(log) \{$c1->[$CI_LOG]\}\n" .
"set ci-${count}(treeopen) 1\n";
$count++;
$first = $i;
}
$i++;
}
}
sub make_fullinfo{
local( $ci ) = @_;
local( $s );
$a = &tcl_value( $ci->[$CI_FILE] );
$b = &tcl_value( $ci->[$CI_REV] );
$c = &tcl_value( $ci->[$CI_LINES_ADDED] );
$d = &tcl_value( $ci->[$CI_LINES_REMOVED] );
$e = &tcl_value( $ci->[$CI_STICKY] );
return "{$a $b $c $d $e}";
}
sub tcl_value {
local( $a ) = @_;
if( $a eq '' ){
return '{}';
}
else {
return $a;
}
}
#
#
#
sub print_result {
local($result) = @_;
local($ci,$i,$k,$j,$max, $l, $span);
&print_head;
$i = 20;
$k = 0;
$max = @{$result};
while( $k < $max ){
$ci = $result->[$k];
$span = 1;
if( ($l = $ci->[$CI_LOG]) ne '' ){
#
# Calculate the number of consequitive logs that are
# the same and nuke them
#
$j = $k+1;
while( $j < $max && $result->[$j]->[$CI_LOG] eq $l ){
$result->[$j]->[$CI_LOG] = '';
$j++;
}
#
# Make sure we don't break over a description block
#
$span = $j-$k;
if( $span-1 > $i ){
$i = $j-$k;
}
}
&print_ci( $ci, $span );
if( $i <= 0 ){
$i = 20;
print "</TABLE><TABLE border cellspacing=2>\n";
}
else {
$i--;
}
$k++;
}
&print_foot;
}
sub print_ci {
local($ci, $span) = @_;
local($sec,$minute,$hour,$mday,$mon,$year,$t);
local($log);
($sec,$minute,$hour,$mday,$mon,$year) = localtime( $ci->[$CI_DATE] );
$t = sprintf("%02d/%02d/%02d&nbsp;%02d:%02d",$mon+1,$mday,$year,$hour,$minute);
$log = &html_log($ci->[$CI_LOG]);
$rev = $ci->[$CI_REV];
print "<tr>\n";
print "<TD>${sm_font_tag}$t</font>";
print "<TD><a href='../registry/who.cgi?email=$ci->[$CI_WHO]' "
. "onClick=\"return js_who_menu('$ci->[$CI_WHO]','',event);\" >"
. "$ci->[$CI_WHO]</a>\n";
print "<TD><a href='cvsview2.cgi?subdir=$ci->[$CI_DIR]&files=$ci->[$CI_FILE]\&command=DIRECTORY&branch=$query_branch&root=$CVS_ROOT'\n"
. " onclick=\"return js_file_menu('$CVS_ROOT', '$ci->[$CI_DIR]','$ci->[$CI_FILE]','$ci->[$CI_REV]','$query_branch',event)\">\n";
# if( (length $ci->[$CI_FILE]) + (length $ci->[$CI_DIR]) > 30 ){
# $d = $ci->[$CI_DIR];
# if( (length $ci->[$CI_DIR]) > 30 ){
# $d =~ s/([^\n]*\/)(classes\/)/$1classes\/<br>&nbsp;&nbsp/;
# # Insert a <BR> before any directory named
# # 'classes.'
# }
# print " $d/<br>&nbsp;&nbsp;$ci->[$CI_FILE]<a>\n";
# }
# else{
# print " $ci->[$CI_DIR]/$ci->[$CI_FILE]<a>\n";
# }
$d = "$ci->[$CI_DIR]/$ci->[$CI_FILE]";
if( $query_module eq 'allrepositories' ){ $d = "$ci->[$CI_REPOSITORY]/$d"; }
$d =~ s:/:/ :g; # Insert a whitespace after any slash, so that
# we'll break long names at a reasonable place.
print "$d\n";
if( $rev ne '' ){
$prevrev = &PrevRev( $rev );
print "<TD>${sm_font_tag}<a href='cvsview2.cgi?diff_mode=".
"context\&whitespace_mode=show\&subdir=".
$ci->[$CI_DIR] . "\&command=DIFF_FRAMESET\&file=" .
$ci->[$CI_FILE] . "\&rev1=$prevrev&rev2=$rev&root=$CVS_ROOT'>$rev</a></font>\n";
}
else {
print "<TD>\&nbsp;\n";
}
if( !$query_branch_head ){
print "<TD><TT><FONT SIZE=-1>$ci->[$CI_BRANCH]&nbsp</FONT></TT>\n";
}
print "<TD>${sm_font_tag}$ci->[$CI_LINES_ADDED]/$ci->[$CI_LINES_REMOVED]</font>&nbsp\n";
if( $log ne '' ){
eval ('$log =~ s@\d{4,6}@' . $BUGSYSTEMEXPR . '@g;');
$log =~ s/([ #\t])([0-9][0-9][0-9][0-9][0-9])([^0-9])/$1<a href='http:\/\/scopus.mcom.com\/bugsplat\/show_bug.cgi?id=$2'>$2<\/a>$3/g;
# Makes numbers into links to bugsplat.
$log =~ s/\n/<BR>/g;
# Makes newlines into <BR>'s
if( $span > 1 ){
print "<TD VALIGN=TOP ROWSPAN=$span>$log\n";
}
else {
print "<TD VALIGN=TOP>$log\n";
}
}
print "</tr>\n";
}
sub print_head {
if ($versioninfo ne "") {
print "<FORM action='multidiff.cgi' method=get>";
print "<INPUT TYPE='HIDDEN' name='allchanges' value = '$versioninfo'>";
print "<INPUT TYPE='HIDDEN' name='cvsroot' value = '$CVS_ROOT'>";
print "<INPUT TYPE=SUBMIT VALUE='Show me ALL the Diffs'>";
print "</FORM>";
print "<tt>(+$lines_added/$lines_removed)</tt> Lines changed.";
}
$anchor = $ENV{QUERY_STRING};
$anchor =~ s/\&sortby\=[A-Za-z\ \+]*//g;
$anchor = "<a href=cvsquery.cgi?$anchor";
print "
<TABLE border cellspacing=2>
<b><TR ALIGN=LEFT>
<TH width=2% $head_date>$anchor>When</a>
<TH width=2% $head_who>${anchor}&sortby=Who>Who</a>
<TH width=45% $head_file>${anchor}&sortby=File>File</a>
<TH width=2%>Rev
";
$descwidth = 47;
if( !$query_branch_head ){
print "<TH width=2%>Branch\n";
$descwidth -= 2;
}
print "
<TH width=2% $head_delta>${anchor}&sortby=Change+Size>+/-</a>
<TH WIDTH=$descwidth%>Description
</TR></b>
";
}
sub print_foot {
print "</TABLE>";
print "<br><br>";
}
sub html_log {
local( $log ) = @_;
$log =~ s/&/&amp;/g;
$log =~ s/</&lt;/g;
return $log;
}
sub PrevRev {
local( $rev ) = @_;
local( $i, $j, $ret, @r );
@r = split( /\./, $rev );
$i = @r-1;
$r[$i]--;
if( $r[$i] == 0 ){
$i -= 2;
}
$j = 0;
while( $j < $i ){
$ret .= "$r[$j]\.";
$j++
}
$ret .= $r[$i];
}
sub parse_date {
my($d) = @_;
my($result) = str2time($d);
if (defined $result) {
return $result;
} elsif ($d > 7000000) {
return $d;
}
return 0;
}
sub setup_script {
$script_str =<<'ENDJS';
<script>
function js_who_menu(n,extra,d) {
if( parseInt(navigator.appVersion) < 4 ){
return true;
}
l = document.layers['popup'];
l.src="../registry/who.cgi?email="+n+extra;
l.top = d.target.y - 6;
l.left = d.target.x - 6;
if( l.left + l.clipWidth > window.width ){
l.left = window.width - l.clipWidth;
}
l.visibility="show";
return false;
}
function js_file_menu(repos,dir,file,rev,branch,d) {
if( parseInt(navigator.appVersion) < 4 ){
return true;
}
l = document.layers['popup'];
l.src="../registry/file.cgi?cvsroot="+repos+"&file="+file+"&dir="+dir+"&rev="+rev+"&branch="+branch+"&linked_text="+d.target.text;
l.top = d.target.y - 6;
l.left = d.target.x - 6;
if( l.left + l.clipWidth > window.width ){
l.left = window.width - l.clipWidth;
}
l.visibility="show";
return false;
}
</script>
<layer name="popup" onMouseOut="this.visibility='hide';" left=0 top=0 bgcolor="#ffffff" visibility="hide">
</layer>
ENDJS
}
#
# Actually do the query
#
sub query_to_english {
my $english = 'Checkins ';
if( $query_module eq 'allrepositories' ){
$english .= "to <i>All Repositories</i> ";
}
elsif( $query_module ne 'all' && @query_dirs == 0 ){
$english .= "to module <i>$query_module</i> ";
}
elsif( $form{dir} ne "" ) {
my $word = "directory";
if (@query_dirs > 1) {
$word = "directories";
}
$english .= "to $word <i>$form{dir}</i> ";
}
if ($query_file ne "") {
if ($english ne 'Checkins ') {
$english .= "and ";
}
$english .= "to file $query_file ";
}
if( ! ($query_branch =~ /^[ ]*HEAD[ ]*$/i) ){
if($query_branch eq '' ){
$english .= "on all branches ";
}
else {
$english .= "on branch <i>$query_branch</i> ";
}
}
if( $query_who ne '' ){
$english .= "by $query_who ";
}
$query_date_type = $form{'date'};
if( $query_date_type eq 'hours' ){
$english .="in the last $form{hours} hours";
}
elsif( $query_date_type eq 'day' ){
$english .="in the last day";
}
elsif( $query_date_type eq 'week' ){
$english .="in the last week";
}
elsif( $query_date_type eq 'month' ){
$english .="in the last month";
}
elsif( $query_date_type eq 'all' ){
$english .="since the beginning of time";
}
elsif( $query_date_type eq 'explicit' ){
if ( $form{mindate} ne "" && $form{maxdate} ne "" ) {
$w1 = "between";
$w2 = "and" ;
}
else {
$w1 = "since";
$w2 = "before";
}
if( $form{'mindate'} ne "" ){
$dd = &parse_date($form{'mindate'});
($sec,$minute,$hour,$mday,$mon,$year) = localtime( $dd );
$t = sprintf("%02d/%02d/%02d&nbsp;%02d:%02d",$mon+1,$mday,$year,$hour,$minute);
$english .= "$w1 <i>$t</i> ";
}
if( $form{'maxdate'} ne "" ){
$dd = &parse_date($form{'maxdate'});
($sec,$minute,$hour,$mday,$mon,$year) = localtime( $dd );
$t = sprintf("%02d/%02d/%02d&nbsp;%02d:%02d",$mon+1,$mday,$year,$hour,$minute);
$english .= "$w2 <i>$t</i> ";
}
}
return $english . ":";
}

443
webtools/bonsai/cvsquery.pl Executable file
Просмотреть файл

@ -0,0 +1,443 @@
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Bonsai CVS tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
require 'utils.pl';
#
# Constants
#
$CI_CHANGE=0;
$CI_DATE=1;
$CI_WHO=2;
$CI_REPOSITORY=3;
$CI_DIR=4;
$CI_FILE=5;
$CI_REV=6;
$CI_STICKY=7;
$CI_BRANCH=8;
$CI_LINES_ADDED=9;
$CI_LINES_REMOVED=10;
$CI_LOG=11;
$NOT_LOCAL = 1;
$IS_LOCAL = 2;
if( $CVS_ROOT eq "" ){
$CVS_ROOT = pickDefaultRepository();
}
#global variables
$lines_added = 0;
$lines_removed = 0;
$modules = {};
if( $ENV{"OS"} eq "Windows_NT" ){
# for debugging purposes
$CVS_MODULES='k:/warp/projects/bonsai/modules';
}
else {
$CVS_MODULES="${CVS_ROOT}/CVSROOT/modules";
#$CVS_MODULES='data/modules';
}
open( MOD, "<$CVS_MODULES") || die "can't open ${CVS_MODULES}";
&parse_modules;
close( MOD );
1;
#
# Actually do the query
#
sub query_checkins {
local($mod_map) = @_;
local($ci,$result,$lastlog,$rev,$begin_tag,$end_tag);
if( $query_module ne 'all' && $query_module ne 'allrepositories' && @query_dirs == 0 ){
$have_mod_map = 1;
$mod_map = &get_module_map( $query_module );
}
else {
$have_mod_map = 0;
$mod_map = {};
}
for $i (@query_dirs ){
$i =~ s:^/::; # Strip leading slash.
$i =~ s:/$::; # Strip trailing slash.
if( !$have_mod_map ){
$mod_map = {};
$have_mod_map = 1;
}
$mod_map->{$i} = $NOT_LOCAL;
}
if( $query_branch =~ /^[ ]*HEAD[ ]*$/i ){
$query_branch_head = 1;
}
$begin_tag = "";
$end_tag = "";
if ( $query_begin_tag ne '') {
$begin_tag = load_tag($query_begin_tag);
}
if ( $query_end_tag ne '') {
$end_tag = load_tag($query_end_tag);
}
$result = [];
my $db = ConnectToDatabase();
my $qstring = "select type, UNIX_TIMESTAMP(when), people.who, repositories.repository, dirs.dir, files.file, revision, stickytag, branches.branch, addedlines, removedlines, descs.description from checkins,people,repositories,dirs,files,branches,descs where people.id=whoid and repositories.id=repositoryid and dirs.id=dirid and files.id=fileid and branches.id=branchid and descs.id=descid";
if( $query_module ne 'allrepositories' ){
$qstring .= " and repositories.repository = '$CVS_ROOT'";
}
if ($query_date_min) {
my $t = formatSqlTime($query_date_min);
$qstring .= " and when >= '$t'";
}
if ($query_date_max) {
my $t = formatSqlTime($query_date_max);
$qstring .= " and when <= '$t'";
}
if ($query_branch_head) {
$qstring .= " and branches.branch = ''";
} elsif ($query_branch ne '') {
my $q = SqlQuote($query_branch);
if ($query_branchtype eq 'regexp') {
$qstring .=
" and branches.branch regexp '$q'";
} else {
$qstring .=
" and (branches.branch = '$q' or branches.branch = 'T$q')";
}
}
if( $query_file ne '') {
my $q = SqlQuote($query_file);
if ($query_filetype eq 'regexp') {
$qstring .= " and files.file regexp '$q'";
} else {
$qstring .= " and files.file = '$q'";
}
}
if ($query_who ne '') {
my $q = SqlQuote($query_who);
if ($query_whotype eq 'regexp') {
$qstring .= " and people.who regexp '$q'";
} else {
$qstring .= " and people.who = '$q'";
}
}
if ($query_logexpr ne '') {
my $q = SqlQuote($query_logexpr);
$qstring .= " and descs.description regexp '$q'";
}
if ($query_debug) {
print "<pre wrap> Query: $qstring</PRE>";
}
$query = $db->Query($qstring) || die $Mysql::db_errstr;
$lastlog = 0;
while(@row = $query->fetchrow) {
$ci = [];
# print "<pre>";
for ($i=0 ; $i<=$CI_LOG ; $i++) {
$ci->[$i] = $row[$i];
# print "$row[$i] ";
}
# print "</pre>";
if( $have_mod_map &&
!&in_module( $mod_map, $ci->[$CI_DIR], $ci->[$CI_FILE] ) ){
next;
}
if( $begin_tag) {
$key = "$ci->[$CI_DIR]/$ci->[$CI_FILE]";
$rev = $begin_tag->{$key};
print "<BR>$key begintag is $rev<BR>\n";
if ($rev == "" || rev_is_after($ci->[$CI_REV], $rev)) {
next;
}
}
if( $end_tag) {
$key = "$ci->[$CI_DIR]/$ci->[$CI_FILE]";
$rev = $end_tag->{$key};
print "<BR>$key endtag is $rev<BR>\n";
if ($rev == "" || rev_is_after($rev, $ci->[$CI_REV])) {
next;
}
}
if( $query_logexpr ne '' && !($ci->[$CI_LOG] =~ /$query_logexpr/i) ){
next;
}
push( @$result, $ci );
}
for $ci (@{$result}) {
$lines_added += $ci->[$CI_LINES_ADDED];
$lines_removed += $ci->[$CI_LINES_REMOVED];
$versioninfo .= "$ci->[$CI_WHO]|$ci->[$CI_DIR]|$ci->[$CI_FILE]|$ci->[$CI_REV],";
}
return $result;
}
sub load_tag {
my $tagname = @_[0];
my $tagfile;
my $cvssuffix;
my $s;
my @line;
my $time;
my $cmd;
my $dir;
$cvssuffix = $CVS_ROOT;
$cvssuffix =~ s/\//_/g;
$s = $tagname;
$s =~ s/ /\%20/g;
$s =~ s/\%/\%25/g;
$s =~ s/\//\%2f/g;
$s =~ s/\?/\%3f/g;
$s =~ s/\*/\%2a/g;
$tagfile = "data/taginfo/$cvssuffix/$s";
open(TAG, "<$tagfile") || die "Unknown tag $tagname";
$result = {};
print "<br>parsing tag $tagname</br>\n";
while ( <TAG> ) {
chop;
@line = split(/\|/);
$time = shift @line;
$cmd = shift @line;
if ($cmd != "add") {
# We ought to be able to cope with these... XXX
next;
}
$dir = shift @line;
$dir =~ s:^$CVS_ROOT/::;
$dir =~ s:^\./::;
while (@line) {
$file = shift @line;
$file = "$dir/$file";
$version = shift @line;
$result->{$file} = $version;
print "<br>Added ($file,$version) for tag $tagname<br>\n";
}
}
return $result;
}
sub rev_is_after {
my $r1 = shift @_;
my $r2 = shift @_;
my @a = split /:/, $r1;
my @b = split /:/, $r2;
if (@b > @a) {
return 1;
}
if (@b < @a) {
return 0;
}
for (my $i=0 ; $i<@a ; $i++) {
if ($a[$i] > $b[$i]) {return 1;}
if ($a[$i] < $b[$i]) {return 0;}
}
return 0;
}
sub find_date_offset {
local( $o, $d, $done, $line );
$done = 0;
local($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
$atime,$mtime,$ctime,$blksize,$blocks) = stat($CHECKIN_INDEX_FILE);
if ($mtime eq "" || time() - $mtime> 24 * 60 * 60) {
print "<h1>Please wait -- rebuilding index file...</h1>\n";
system "./cvsindex.pl $CVS_ROOT";
print "<h1>...OK, done.</h1>\n";
}
Lock();
if(! open(IDX , "<$CHECKIN_INDEX_FILE") ){
print "<h1>can't open index</h1>";
Unlock();
return 0;
}
$i = 0;
while( ($line = <IDX>) && !$done){
chop($line);
($o,$d) = split(/\|/,$line);
if( $d && $query_date_min > $d ){
$done = 1;
}
$i++;
}
if( $F_DEBUG ){
print "seekdate($d) seekoffset($o) readcount($i)\n";
}
close IDX;
Unlock();
return $o;
}
sub in_module {
local($mod_map, $dirname, $filename ) = @_;
local( @path );
local( $i, $fp, $local );
#
#quick check if it is already in there.
#
if( $mod_map{$dirname} ){
return 1;
}
@path = split(/\//, $dirname);
$fp = '';
for( $i = 0; $i < @path; $i++){
$fp .= ($fp ne '' ? '/' : '') . $path[$i];
if( $local = $mod_map->{$fp} ){
if( $local == $IS_LOCAL ){
if( $i == (@path-1) ){
return 1;
}
}
else {
# Add directories to the map as we encounter them so we go
# faster
if( $mod_map{$dirname} == 0 ){
$mod_map{$dirname} = $IS_LOCAL;
}
return 1;
}
}
}
if( $mod_map->{ $fp . '/' . $filename} ) {
return 1;
}
else {
return 0;
}
}
sub get_module_map {
local($name) = @_;
local($mod_map);
$mod_map = {};
&build_map( $name, $mod_map );
return $mod_map;
}
sub parse_modules {
while( $l = &get_line ){
($mod_name, $flag, @params) = split(/[ \t]+/,$l);
if( $flag ne '-a' ){
next;
}
$modules->{$mod_name} = [@params];
}
}
sub build_map {
local($name,$mod_map) = @_;
local($bFound, $local);
$local = $NOT_LOCAL;
$bFound = 0;
for $i ( @{$modules->{$name}} ){
$bFound = 1;
if( $i eq '-l' ){
$local = $IS_LOCAL;
}
elsif( !build_map($i, $mod_map )){
$mod_map->{$i} = $local;
}
}
return $bFound;
}
sub get_line {
local($l, $save);
$bContinue = 1;
while( $bContinue && ($l = <MOD>) ){
chop($l);
if( $l =~ /^[ \t]*\#/
|| $l =~ /^[ \t]*$/ ){
$l='';
}
elsif( $l =~ /\\[ \t]*$/ ){
chop ($l);
$save .= $l . ' ';
}
elsif( $l eq '' && $save eq ''){
# ignore blank lines
}
else {
$bContinue = 0;
}
}
return $save . $l;
}

321
webtools/bonsai/cvsqueryform.cgi Executable file
Просмотреть файл

@ -0,0 +1,321 @@
#!/usr/bonsaitools/bin/perl --
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Bonsai CVS tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
# Query the CVS database.
#
require 'lloydcgi.pl';
require 'cvsmenu.pl';
require 'utils.pl';
$|=1;
$CVS_ROOT = $form{"cvsroot"};
print "Content-type: text/html\n\n";
require 'modules.pl';
EmitHtmlHeader("CVS Query Form", $CVS_ROOT);
print "
<p>
<FORM METHOD=GET ACTION='cvsquery.cgi'>
<p>
<TABLE BORDER CELLPADDING=8 CELLSPACING=0>
";
#
# module selector
#
print "
<TR><TH ALIGN=RIGHT>Module:</TH>
<TD>
<SELECT name='module' size=5>
";
#
# check to see if there are multple repositories
#
@reposList = &getRepositoryList();
$bMultiRepos = (@reposList > 1);
#
# This code sucks, I should rewrite it to be shorter
#
if( $form{module} eq 'all' || $form{module} eq '' ){
print "<OPTION SELECTED VALUE='all'>All Files in the Repository\n";
if( $bMultiRepos ){
print "<OPTION VALUE='allrepositories'>All Files in all Repositories\n";
}
}
elsif( $form{module} eq 'allrepositories' ){
print "<OPTION VALUE='all'>All Files in the Repository\n";
if( $bMultiRepos ){
print "<OPTION SELECTED VALUE='allrepositories'>All Files in all Repositories\n";
}
}
else {
print "<OPTION VALUE='all'>All Files in the Repository\n";
if( $bMultiRepos ){
print "<OPTION VALUE='allrepositories'>All Files in all Repositories\n";
}
print "<OPTION SELECTED VALUE='$form{module}'>$form{module}\n";
}
#
# Print out all the Different Modules
#
for $k (sort( keys( %$modules ) ) ){
print "<OPTION value='$k'>$k\n";
}
print "</SELECT></td>\n";
print "<td rowspan=2>";
cvsmenu();
print "</td></tr>";
#
# Branch
#
if( defined $form{branch} ){
$b = $form{branch};
}
else {
$b = "HEAD";
}
print "<tr>
<th align=right>Branch:</th>
<td> <input type=text name=branch value='$b' size=25><br>\n" .
regexpradio('branchtype') .
"<br>(leaving this field empty will show you checkins on both
<tt>HEAD</tt> and branches)
</td></tr>";
#
# Query by directory
#
print "
<tr>
<th align=right>Directory:</th>
<td colspan=2>
<input type=text name=dir value='$form{dir}' size=45><br>
(you can list multiple directories)
</td>
</tr>
";
print "
<tr>
<th align=right>File:</th>
<td colspan=2>
<input type=text name=file value='$form{file}' size=45><br>" .
regexpradio('filetype') . "
</td>
</tr>
";
#
# Who
#
print "
<tr>
<th align=right>Who:</th>
<td colspan=2> <input type=text name=who value='$form{who}' size=45><br>" .
regexpradio('whotype') . "
</td>
</tr>";
#
# Log contains
#
#print "
#<br>
#<nobr><b>Log contains:</b>
#<input type=text name=logexpr size=45></nobr>(you can use <a href=cvsregexp.html>regular expressions</a>)\n";
#
# Sort order
#
print "
<tr>
<th align=right>Sort By:</th>
<td colspan=2>
<SELECT name='sortby'>
<OPTION" . &sortTest("Date") . ">Date
<OPTION" . &sortTest("Who") . ">Who
<OPTION" . &sortTest("File") . ">File
<OPTION" . &sortTest("Change Size") . ">Change Size
</SELECT>
</td>
</tr>
";
#
# Print the date selector
#
$CVS_REPOS_SUFFIX = $CVS_ROOT;
$CVS_REPOS_SUFFIX =~ s:/:_:g;
$startdate = fetchCachedStartDate($CVS_ROOT);
if ($form{date} eq "") {
$form{date} = "hours";
}
print "
<tr>
<th align=right valign=top><br>Date:</th>
<td colspan=2>
<table BORDER=0 CELLSPACING=0 CELLPADDING=0>
<tr>
<td><input type=radio name=date " . &dateTest("hours") . "></td>
<td>In the last <input type=text name=hours value=2 size=4> hours</td>
</tr><tr>
<td><input type=radio name=date " . &dateTest("day") . "></td>
<td>In the last day</td>
</tr><tr>
<td><input type=radio name=date " . &dateTest("week") . "></td>
<td>In the last week</td>
</tr><tr>
<td><input type=radio name=date " . &dateTest("month") . "></td>
<td>In the last month</td>
</tr><tr>
<td><input type=radio name=date " . &dateTest("all") . "></td>
<td>Since the beginning of time (which happens to be <TT><NOBR>$startdate</NOBR></TT> currently)</td>
</tr><tr>
<td><input type=radio name=date " . &dateTest("explicit") . "></td>
<td><table BORDER=0 CELLPADDING=0 CELLPSPACING=0>
<tr>
<TD VALIGN=TOP ALIGN=RIGHT NOWRAP>
Between <input type=text name=mindate value='$form{mindate}' size=25></td>
<td valign=top rowspan=2>You can use the form
<B><TT><NOBR>mm/dd/yy hh:mm:ss</NOBR></TT></B> or a Unix <TT>time_t</TT>
(seconds since the Epoch.)
</td>
</tr>
<tr>
<td VALIGN=TOP ALIGN=RIGHT NOWRAP>
and <input type=text name=maxdate '$form{maxdate}' size=25></td>
</tr>
</table>
</td>
</tr>
</table>
</tr>
";
print "
<tr>
<th><BR></th>
<td colspan=2>
<INPUT TYPE=HIDDEN NAME=cvsroot VALUE='$CVS_ROOT'>
<INPUT TYPE=SUBMIT VALUE='Run Query'>
</td>
</tr>
</table>
</FORM>";
sub sortTest {
if( $_[0] eq $form{sortby} ){
return " SELECTED";
}
else {
return "";
}
}
refigureStartDateIfNecessary($CVS_ROOT);
sub dateTest {
if( $_[0] eq $form{date} ){
return " CHECKED value=$_[0]";
}
else {
return "value=$_[0]";
}
}
sub regexpradio {
my($name) = @_;
my $useregexp = ($form{$name} eq 'regexp');
my $c1 = $useregexp ? "" : "checked";
my $c2 = $useregexp ? "checked" : "";
return "
<input type=radio name=$name value=match $c1>Exact match
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
<input type=radio name=$name value=regexp $c2><a href=cvsregexp.html>Regular expression</a>";
}
sub fetchCachedStartDate {
my ($repository) = @_;
open(CACHE, "<data/cachedstartdates") || return "unknown";
while (<CACHE>) {
chop();
my($rep,$date,$cachedate) = split(/\|/);
if ($rep eq $repository) {
$rememberedcachedate = $cachedate;
return $date;
}
}
return "unknown";
}
sub refigureStartDateIfNecessary {
my ($repository) = @_;
my $now = time();
if ((defined $rememberedcachedate) &&
$now - $rememberedcachedate < 24*60*60 &&
$rememberedcachedate < $now) {
return;
}
my $db = ConnectToDatabase();
my $query = $db->Query("select min(when) from checkins,repositories where repositories.id = repositoryid and repository = '$CVS_ROOT'") || die $Mysql::db_errstr;
my @row = $query->fetchrow();
my $startdate = $row[0];
if ($startdate eq "") {
$startdate = "nonexistant";
}
open(OUTCACHE, ">data/cachedstartdates.$$") || die "Can't open output date cache file";
if (open(INCACHE, "<data/cachedstartdates")) {
while (<INCACHE>) {
chop();
my($rep,$date,$cachedate) = split(/\|/);
if ($rep ne $repository) {
print OUTCACHE "$_\n";
}
}
close INCACHE;
}
print OUTCACHE "$repository|$startdate|$now\n";
close OUTCACHE;
rename "data/cachedstartdates.$$", "data/cachedstartdates";
}

257
webtools/bonsai/cvsregexp.html Normal file
Просмотреть файл

@ -0,0 +1,257 @@
<HTML>
<HEAD>
<META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=iso-8859-1">
<META NAME="Author" CONTENT="lloyd tabb">
<META NAME="GENERATOR" CONTENT="Mozilla/4.0 [en] (WinNT; I) [Netscape]">
<TITLE>Regular expressions in the cvs query tool</TITLE>
</HEAD>
<BODY>
<H1>
Description of MySQL regular expression syntax.</H1>
Regular expressions are a powerful way of specifying complex searches.
<P><B>MySQL</B> uses regular Henry Spencers inplementation of regular expressions.
And that is aimed to conform to POSIX 1003.2. <B>MySQL</B> uses the extended
version.
<P>To get more exact information see Henry Spencers regex.7 manual.
<P>This is a simplistic reference that skips the details. From here on
a regualr expressions is called a regexp.
<P>A regular expression describes a set of strings. The simplest case is
one that has no special characters in it. For example the regexp <TT>hello</TT>
matches <TT>hello</TT> and nothing else.
<P>Nontrivial regular expressions use certain special constructs so that
they can match more than one string. For example, the regexp <TT>hello|word</TT>
matches either the string <TT>hello</TT> or the string <TT>word</TT>.
<P>And a more comples example regexp <TT>B[an]*s</TT> matches any of the
strings <TT>Bananas</TT>, <TT>Baaaaas</TT>, <TT>Bs</TT> and all other string
starting with a <TT>B</TT> and continuing with any number of <TT>a</TT>
<TT>n</TT> and ending with a <TT>s</TT>.
<P>The following special characters/constructs are known.
<DL COMPACT>
<DT>
<TT>^</TT></DT>
<DD>
Start of whole string.</DD>
<PRE>mysql> select "fo\nfo" regexp "^fo$";&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; -> 0
mysql> select "fofo" regexp "^fo";&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; -> 1</PRE>
<DT>
<TT>$</TT></DT>
<DD>
End of whole string.</DD>
<PRE>mysql> select "fo\no" regexp "^fo\no$";&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; -> 1
mysql> select "fo\no" regexp "^fo$";&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; -> 0</PRE>
<DT>
<TT>.</TT></DT>
<DD>
Any character (including newline).</DD>
<PRE>mysql> select "fofo" regexp "^f.*";&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; -> 1
mysql> select "fo\nfo" regexp "^f.*";&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; -> 1</PRE>
<DT>
<TT>a*</TT></DT>
<DD>
Any sequence of zero or more a's.</DD>
<PRE>mysql> select "Ban" regexp "^Ba*n";&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; -> 1
mysql> select "Baaan" regexp "^Ba*n";&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; -> 1
mysql> select "Bn" regexp "^Ba*n";&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; -> 1</PRE>
<DT>
<TT>a+</TT></DT>
<DD>
Any sequence of one or more a's.</DD>
<PRE>mysql> select "Ban" regexp "^Ba+n";&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; -> 1
mysql> select "Bn" regexp "^Ba+n";&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; -> 0</PRE>
<DT>
<TT>a?</TT></DT>
<DD>
Either zero or one a.</DD>
<PRE>mysql> select "Bn" regexp "^Ba?n";&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; -> 1
mysql> select "Ban" regexp "^Ba?n";&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; -> 1
mysql> select "Baan" regexp "^Ba?n";&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; -> 0</PRE>
<DT>
<TT>de|abc</TT></DT>
<DD>
Either the sequence <TT>de</TT> or <TT>abc</TT>.</DD>
<PRE>mysql> select "pi" regexp "pi|apa";&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; -> 1
mysql> select "axe" regexp "pi|apa";&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; -> 0
mysql> select "apa" regexp "pi|apa";&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; -> 1
mysql> select "apa" regexp "^(pi|apa)$";&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; -> 1
mysql> select "pi" regexp "^(pi|apa)$";&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; -> 1
mysql> select "pix" regexp "^(pi|apa)$";&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; -> 0</PRE>
<DT>
<TT>(abc)*</TT></DT>
<DD>
Zero or more times the sequence <TT>abc</TT>.</DD>
<PRE>mysql> select "pi" regexp "^(pi)+$";&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; -> 1
mysql> select "pip" regexp "^(pi)+$";&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; -> 0
mysql> select "pipi" regexp "^(pi)+$";&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; -> 1</PRE>
<DT>
<TT>{1}</TT></DT>
<DT>
<TT>{2,3}</TT></DT>
<DD>
The is a more general way of writing regexps that match many occurences.</DD>
<DL COMPACT>
<DT>
<TT>a*</TT></DT>
<DD>
Can be written as <TT>a{0,}</TT>.</DD>
<DT>
<TT>+</TT></DT>
<DD>
Can be written as <TT>a{1,}</TT>.</DD>
<DT>
<TT>?</TT></DT>
<DD>
Can be written as <TT>a{0,1}</TT>.</DD>
</DL>
To be more precice an atom followed by a bound containing one integer <TT>i</TT>
and no comma matches a sequence of exactly <TT>i</TT> matches of the atom.
An atom followed by a bound containing one integer <TT>i</TT> and a comma
matches a sequence of <TT>i</TT> or more matches of the atom. An atom followed
by a bound containing two integers <TT>i</TT> and <TT>j</TT> matches a
sequence of <TT>i</TT> through <TT>j</TT> (inclusive) matches of the atom.
Both arguments must <TT>0 >= value &lt;= RE_DUP_MAX (default 255)</TT>,
and if there are two of them, the second must be bigger or equal to the
first.
<DT>
<TT>[a-dX]</TT></DT>
<DT>
<TT>[^a-dX]</TT></DT>
<DD>
Any character which is (not if ^ is used) either <TT>a</TT>, <TT>b</TT>,
<TT>c</TT>, <TT>d</TT> or <TT>X</TT>. To include <TT>]</TT> it has to be
written first. To include <TT>-</TT> it has to be written first or last.
So <TT>[0-9]</TT> matches any decimal digit. All character that does not
have a defined mening inside a <TT>[]</TT> pair has no special meaning
and matches only itself.</DD>
<PRE>mysql> select "aXbc" regexp "[a-dXYZ]";&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; -> 1
mysql> select "aXbc" regexp "^[a-dXYZ]$";&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; -> 0
mysql> select "aXbc" regexp "^[a-dXYZ]+$";&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; -> 1
mysql> select "aXbc" regexp "^[^a-dXYZ]+$";&nbsp;&nbsp;&nbsp;&nbsp; -> 0
mysql> select "gheis" regexp "^[^a-dXYZ]+$";&nbsp;&nbsp;&nbsp; -> 1
mysql> select "gheisa" regexp "^[^a-dXYZ]+$";&nbsp;&nbsp; -> 0</PRE>
<DT>
<TT>[[.characters.]]</TT></DT>
<DD>
The sequence of characters of that collating element. The sequence is a
single element of the bracket expression's list. A bracket expression containing
a multi-character collating element can thus match more than one character,
e.g. if the collating sequence includes a <TT>ch</TT> collating element,
then the RE <TT>[[.ch.]]*c</TT> matches the first five characters of <TT>chchcc</TT>.</DD>
<DT>
<TT>[=character-class=]</TT></DT>
<DD>
An equivalence class, standing for the sequences of characters of all collating
elements equivalent to that one, including itself. For example, if <TT>o</TT>
and <TT>(+)</TT> are the members of an equivalence class, then <TT>[[=o=]]</TT>,
<TT>[[=(+)=]]</TT>, and <TT>[o(+)]</TT> are all synonymous. An equivalence
class may not be an endpoint of a range.</DD>
<DT>
<TT>[:character_class:]</TT></DT>
<DD>
Within a bracket expression, the name of a character class enclosed in
<TT>[:</TT> and <TT>:]</TT> stands for the list of all characters belonging
to that class. Standard character class names are:</DD>
<TABLE BORDER WIDTH="100%" NOSAVE >
<TR>
<TD>alnum&nbsp;</TD>
<TD>digit&nbsp;</TD>
<TD>punct&nbsp;</TD>
</TR>
<TR>
<TD>alpha&nbsp;</TD>
<TD>graph&nbsp;</TD>
<TD>space&nbsp;</TD>
</TR>
<TR>
<TD>blank&nbsp;</TD>
<TD>lower&nbsp;</TD>
<TD>upper&nbsp;</TD>
</TR>
<TR>
<TD>cntrl&nbsp;</TD>
<TD>print&nbsp;</TD>
<TD>xdigit&nbsp;</TD>
</TR>
</TABLE>
These stand for the character classes defined in ctype(3). A locale may
provide others. A character class may not be used as an endpoint of a range.
<PRE>mysql> select "justalnums" regexp "[[:alnum:]]+";&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; -> 1
mysql> select "!!" regexp "[[:alnum:]]+";&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; -> 0</PRE>
<LI>
[[:&lt;:]]</LI>
<LI>
[[:>:]] These match the null string at the beginning and end of a word
respectively. A word is defined as a sequence of word characters which
is neither preceded nor followed by word characters. A word character is
an alnum character (as defined by ctype(3)) or an underscore.</LI>
<PRE>mysql> select "a word a" regexp "[[:&lt;:]]word[[:>:]]";&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; -> 1
mysql> select "a xword a" regexp "[[:&lt;:]]word[[:>:]]";&nbsp;&nbsp;&nbsp;&nbsp; -> 0</PRE>
</DL>
<PRE>mysql> select "weeknights" regexp "^(wee|week)(knights|nights)$"; -> 1</PRE>
&nbsp;
</BODY>
</HTML>

963
webtools/bonsai/cvsview2.cgi Executable file
Просмотреть файл

@ -0,0 +1,963 @@
#!/usr/bonsaitools/bin/perl --
# -*- Mode: perl; indent-tabs-mode: nil -*-
# cvsview.cgi - fake up some HTML based on RCS logs and diffs
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Bonsai CVS tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
# brendan and fur
#
# TODO in no particular order:
# - Mocha-automate the main page's form so clicking on rev links in the table
# change the default filename and revisions.
# - Add a tab width input to the main page's form.
# - Include log message in wasted horizontal real-estate of Shortcuts frame.
# - Make old and new diff lines go to separate, side-by-side frames, and use
# Mocha to slave their scrollbars together.
# - Allow expansion of the top-level table to include the revision histories
# of all the files in the directory.
# - More more more xdiff/gdiff-like features...
#
#
# SRCROOTS is an array of repository roots under which to look for CVS files.
#
# Figure out which directory bonsai is in by looking at argv[0]
$bonsaidir = $0;
$bonsaidir =~ s:/[^/]*$::; # Remove last word, and slash before it.
if ($bonsaidir eq '') {
$bonsaidir = '.';
}
chdir $bonsaidir || die "Couldn't chdir to $bonsaidir";
require 'utils.pl';
loadConfigData();
NEXTTREE: foreach $i (@treelist) {
$r = $treeinfo{$i}->{'repository'};
foreach $j (@SRCROOTS) {
if ($r eq $j) {
next NEXTTREE;
}
}
push @SRCROOTS, $r;
}
$MAX_REVS = 8;
#
# Make sure both kinds of standard output go to STDOUT.
# XXX dup stdout onto stderr and flush stdout after the following prints
#
# Until then, replace standard die built-in with our own.
sub die {
print 'fatal error: ';
print @_;
exit;
}
# Consume one token from the already opened RCSFILE filehandle.
# Unescape string tokens, if necessary.
sub get_token {
# Erase all-whitespace lines.
while ($line_buffer =~ /^$/) {
&die ('Unexpected EOF') if eof(RCSFILE);
$line_buffer = <RCSFILE>;
$line_buffer =~ s/^\s+//; # Erase leading whitespace
}
# A string of non-whitespace characters is a token ...
return $1 if ($line_buffer =~ s/^([^;@][^;\s]*)\s*//o);
# ...and so is a single semicolon ...
return ';' if ($line_buffer =~ s/^;\s*//o);
# ...or an RCS-encoded string that starts with an @ character.
$line_buffer =~ s/^@([^@]*)//o;
$token = $1;
# Detect single @ character used to close RCS-encoded string.
while ($line_buffer !~ /^@[^@]*$/o) {
$token .= $line_buffer;
&die ('Unexpected EOF') if eof(RCSFILE);
$line_buffer = <RCSFILE>;
}
# Retain the remainder of the line after the terminating @ character.
($line_buffer) = ($line_buffer =~ /^@\s*([^@]*)/o);
# Undo escape-coding of @ characters.
$token =~ s/@@/@/og;
return $token;
}
# Consume a token from RCS filehandle and ensure that it matches
# the given string constant.
sub match_token {
local ($match) = @_;
local ($token) = &get_token;
&die ("Unexpected parsing error in RCS file.\n",
"Expected token: $match, but saw: $token\n")
if ($token ne $match);
}
# Push RCS token back into the input buffer.
sub unget_token {
local ($token) = @_;
$line_buffer = "$token $line_buffer";
}
# Parses "administrative" header of RCS files, setting these globals:
#
# $head_revision -- Revision for which cleartext is stored
# $principal_branch
# $file_description
# %revision_symbolic_name -- mapping from numerical revision # to symbolic tag
# %tag_revision -- mapping from symbolic tag to numerical revision #
#
sub parse_rcs_admin {
local ($token, $tag, $tag_name, $tag_revision);
local (@tags);
# Undefine variables, because we may have already read another RCS file
undef %tag_revision;
undef %revision_symbolic_name;
while (1) {
# Read initial token at beginning of line
$token = &get_token(RCSFILE);
# We're done once we reach the description of the RCS tree
if ($token =~ /^\d/o) {
&unget_token($token);
return;
}
# print "token: $token\n";
if ($token eq 'head') {
$head_revision = &get_token;
&get_token; # Eat semicolon
} elsif ($token eq 'branch') {
$principal_branch = &get_token;
&get_token; # Eat semicolon
} elsif ($token eq 'symbols') {
# Create an associate array that maps from tag name to
# revision number and vice-versa.
while (($tag = &get_token) ne ';') {
($tag_name, $tag_revision) = split(':', $tag);
$tag_revision{$tag_name} = $tag_revision;
$revision_symbolic_name{$tag_revision} = $tag_name;
}
} elsif ($token eq 'comment') {
$file_description = &get_token;
&get_token; # Eat semicolon
# Ignore all these other fields - We don't care about them.
} elsif (($token eq 'locks') ||
($token eq 'strict') ||
($token eq 'expand') ||
($token eq 'access')) {
(1) while (&get_token ne ';');
} else {
warn ("Unexpected RCS token: $token\n");
}
}
&die('Unexpected EOF');
}
# Construct associative arrays that represent the topology of the RCS tree
# and other arrays that contain info about individual revisions.
#
# The following associative arrays are created, keyed by revision number:
# %revision_date -- e.g. "96.02.23.00.21.52"
# %timestamp -- seconds since 12:00 AM, Jan 1, 1970 GMT
# %revision_author -- e.g. "tom"
# %revision_branches -- descendant branch revisions, separated by spaces,
# e.g. "1.21.4.1 1.21.2.6.1"
# %prev_revision -- revision number of previous *ancestor* in RCS tree.
# Traversal of this array occurs in the direction
# of the primordial (1.1) revision.
# %prev_delta -- revision number of previous revision which forms the
# basis for the edit commands in this revision.
# This causes the tree to be traversed towards the
# trunk when on a branch, and towards the latest trunk
# revision when on the trunk.
# %next_delta -- revision number of next "delta". Inverts %prev_delta.
#
# Also creates %last_revision, keyed by a branch revision number, which
# indicates the latest revision on a given branch,
# e.g. $last_revision{"1.2.8"} == 1.2.8.5
#
sub parse_rcs_tree {
local($revision, $date, $author, $branches, $next);
local($branch, $is_trunk_revision);
# Undefine variables, because we may have already read another RCS file
undef %revision_date;
undef %timestamp;
undef %revision_author;
undef %revision_branches;
undef %prev_revision;
undef %prev_delta;
undef %next_delta;
undef %last_revision;
while (1) {
$revision = &get_token;
# End of RCS tree description ?
if ($revision eq 'desc') {
&unget_token($revision);
return;
}
$is_trunk_revision = ($revision =~ /^[0-9]+\.[0-9]+$/);
$tag_revision{$revision} = $revision;
($branch) = $revision =~ /(.*)\.[0-9]+/o;
$last_revision{$branch} = $revision;
# Parse date
&match_token('date');
$date = &get_token;
$revision_date{$revision} = $date;
&match_token(';');
# Convert date into timestamp
# @date_fields = reverse(split(/\./, $date));
# $date_fields[4]--; # Month ranges from 0-11, not 1-12
# $timestamp{$revision} = &timegm(@date_fields);
# Parse author
&match_token('author');
$author = &get_token;
$revision_author{$revision} = $author;
&match_token(';');
# Parse state;
&match_token('state');
(1) while (&get_token ne ';');
# Parse branches
&match_token('branches');
$branches = '';
while (($token = &get_token) ne ';') {
$prev_revision{$token} = $revision;
$prev_delta{$token} = $revision;
$branches .= "$token ";
}
$revision_branches{$revision} = $branches;
# Parse revision of next delta in chain
&match_token('next');
$next = '';
if (($token = &get_token) ne ';') {
$next = $token;
&get_token; # Eat semicolon
$next_delta{$revision} = $next;
$prev_delta{$next} = $revision;
if ($is_trunk_revision) {
$prev_revision{$revision} = $next;
} else {
$prev_revision{$next} = $revision;
}
}
if ($debug > 1) {
print "revision = $revision\n";
print "date = $date\n";
print "author = $author\n";
print "branches = $branches\n";
print "next = $next\n\n";
}
}
}
# Reads and parses complete RCS file from already-opened RCSFILE descriptor.
sub parse_rcs_file {
local ($file) = @_;
&die("Couldn't open $file\n") if !open(RCSFILE, "< $file");
$line_buffer = '';
print "Reading RCS admin...\n" if ($debug);
&parse_rcs_admin();
print "Reading RCS revision tree topology...\n" if ($debug);
&parse_rcs_tree();
print "Done reading RCS file...\n" if ($debug);
close(RCSFILE);
}
# Map a tag to a numerical revision number. The tag can be a symbolic
# branch tag, a symbolic revision tag, or an ordinary numerical
# revision number.
sub map_tag_to_revision {
local($tag_or_revision) = @_;
local ($revision) = $tag_revision{$tag_or_revision};
# Is this a branch tag, e.g. xxx.yyy.0.zzz
if ($revision =~ /(.*)\.0\.([0-9]+)/o) {
$branch = $1 . '.' . $2;
# Return latest revision on the branch, if any.
return $last_revision{$branch} if (defined($last_revision{$branch}));
return $1; # No revisions on branch - return branch point
} else {
return $revision;
}
}
#
# Print HTTP content-type header and the header-delimiting extra newline.
#
print "Content-type: text/html\n\n";
$request_method = $ENV{'REQUEST_METHOD'}; # e.g., "GET", "POST", etc.
$script_name = $ENV{'SCRIPT_NAME'};
$prefix = $script_name . $ENV{PATH_INFO} . '?'; # prefix for HREF= entries
$query_string = $ENV{QUERY_STRING};
# Undo % URL-encoding
while ($query_string =~ /(.*)\%([0-9a-fA-F][0-9a-fA-F])(.*)/) {
# XXX - inefficient
$query_string = $1 . pack('c', hex($2)) . $3;
}
&die("REQUEST_METHOD 'GET' expected: got '$request_method'\n")
if ($request_method ne 'GET');
# Default option values
$opt_diff_mode = 'context';
$opt_whitespace_mode = 'show';
# Parse options in URL. For example,
# http://w3/cgi/cvsview.pl?subdir=foo&file=bar would assign
# $opt_subdir = foo and $opt_file = bar.
foreach $option (split(/&/, $query_string)) {
&die("command $opt_command: garbled option $option\n")
if ($option !~ /^([^=]+)=(.*)/);
eval('$opt_' . $1 . '="' . $2 . '";');
}
if( $opt_branch eq 'HEAD' ) { $opt_branch = ''; }
# Configuration colors for diff output.
$stable_bg_color = 'White';
$skipping_bg_color = '#c0c0c0';
$header_bg_color = 'Orange';
$change_bg_color = 'LightBlue';
$addition_bg_color = 'LightGreen';
$deletion_bg_color = 'LightGreen';
$diff_bg_color = 'White';
# Ensure that necessary arguments are present
&die("command not defined in URL\n") if $opt_command eq '';
&die("command $opt_command: subdir not defined\n") if $opt_subdir eq '';
if ($opt_command eq 'DIFF' ||
$opt_command eq 'DIFF_FRAMESET' ||
$opt_command eq 'DIFF_LINKS') {
&die("command $opt_command: file not defined in URL\n") if $opt_file eq '';
&die("command $opt_command: rev1 not defined in URL\n") if $opt_rev1 eq '';
&die("command $opt_command: rev2 not defined in URL\n") if $opt_rev2 eq '';
}
# Propagate diff options to created links
$prefix .= "diff_mode=$opt_diff_mode";
$prefix .= "&whitespace_mode=$opt_whitespace_mode";
$prefix .= "&root=$opt_root";
# Create a shorthand for the longest common initial substring of our URL.
$magic_url = "$prefix&subdir=$opt_subdir";
# Now that we've munged QUERY_STRING into perl variables, set rcsdiff options.
$rcsdiff = '/tools/ns/bin/rcsdiff -f';
$rcsdiff .= ' -w' if ($opt_whitespace_mode eq 'ignore');
# Handle the "root" argument
#
if (defined($root = $opt_root) && $root ne '') {
$root =~ s|/$||;
if (-d $root) {
unshift(@SRCROOTS, $root);
} else {
print "Error: Root, $root, is not a directory.<BR>\n";
print "</BODY></HTML>\n";
exit;
}
}
foreach $root (@SRCROOTS) {
$dir = "$root/$opt_subdir";
if (-d $dir) {
$found = 1;
last;
}
}
if (!$found) {
print "<FONT SIZE=5><B>Error:</B> $opt_subdir not found in "
.join(',', @SRCROOTS), "</FONT>\n";
exit;
}
# Create top-level frameset document.
sub do_diff_frameset {
chdir($dir);
print "<TITLE>$opt_file: $opt_rev1 vs. $opt_rev2</TITLE>\n";
print "<FRAMESET ROWS='*,90' FRAMESPACING=0 BORDER=1>\n";
print " <FRAME NAME=diff+$opt_file+$opt_rev1+$opt_rev2 ",
" SRC=\"$magic_url&command=DIFF";
print "&root=$opt_root" if defined($opt_root);
print "&file=$opt_file&rev1=$opt_rev1&rev2=$opt_rev2\">\n";
print " <FRAME SRC=\"$magic_url&command=DIFF_LINKS";
print "&root=$opt_root" if defined($opt_root);
print "&file=$opt_file&rev1=$opt_rev1&rev2=$opt_rev2\">\n";
print "</FRAMESET>\n";
}
# Create links to document created by DIFF command.
sub do_diff_links {
chdir($dir);
open(RCSDIFF, "$rcsdiff -r$opt_rev1 -r$opt_rev2 $opt_file 2>/dev/null |");
print "<HEAD>\n";
print "<SCRIPT LANGUAGE='JavaScript'>\n";
print "var anchor = -1;\n\n";
print "function nextAnchor() {\n",
" if (anchor < parent.frames[0].document.anchors.length)\n",
" parent.frames[0].location.hash = ++anchor;\n",
"}\n\n";
print "function prevAnchor() {\n",
" if (anchor > 0)\n",
" parent.frames[0].location.hash = --anchor;\n",
"}\n";
print "</SCRIPT>\n";
print "</HEAD>";
print "<BODY BGCOLOR=\"#FFFFFF\" TEXT=\"#000000\"";
print " LINK=\"#0000EE\" VLINK=\"#551A8B\" ALINK=\"#FF0000\">\n";
print "<TITLE>$opt_file: $opt_rev1 vs. $opt_rev2</TITLE>\n";
print '<FORM><TABLE CELLPADDING=0 CELLSPACING=0 BORDER=0><TR VALIGN=TOP>';
my $lxr_base = "http://cvs-mirror.mozilla.org/webtools/lxr/source";
my $diff_base = "cvsview2.cgi";
my $blame_base = "cvsblame.cgi";
# total kludge!! lxr omits the top-level "mozilla" directory...
my $lxr_path = "$opt_subdir/$opt_file";
$lxr_path =~ s@^ns/@@;
$lxr_path =~ s@^mozilla/@@;
my $lxr_link = "$lxr_base/$lxr_path";
my $blame_link = "$blame_base?root=$CVS_ROOT\&file=$opt_subdir/$opt_file";
my $diff_link = "$magic_url&command=DIRECTORY&file=$opt_file&rev1=$opt_rev1&rev2=$opt_rev2";
$diff_link .= "&root=$opt_root" if defined($opt_root);
print "<TD NOWRAP ALIGN=LEFT VALIGN=CENTER>";
print "<TABLE CELLPADDING=0 CELLSPACING=0 BORDER=0>";
print "<TR><TD NOWRAP ALIGN=RIGHT VALIGN=TOP><A HREF=\"$diff_link\" TARGET=_top><B>diff:</B></A> </TD>";
print "<TD NOWRAP>Change diff parameters.</TD></TR>\n";
print "<TR><TD NOWRAP ALIGN=RIGHT VALIGN=TOP><A HREF=\"$blame_link\" TARGET=_top><B>blame:</B></A></TD>";
print "<TD NOWRAP>Annotate line authors.</TD></TR>\n";
print "<TR><TD NOWRAP ALIGN=RIGHT VALIGN=TOP><A HREF=\"$lxr_link\" TARGET=_top><B>lxr:</B></A> </TD>";
print "<TD NOWRAP>Browse source as hypertext.</TD></TR>\n";
print "</TABLE>";
print "</TD>";
print "<TD WIDTH=8</TD>";
print "<TD>";
print "<INPUT TYPE=button VALUE='Prev' ONCLICK='prevAnchor()'><BR>";
print "<INPUT TYPE=button VALUE='Next' ONCLICK='nextAnchor()'>";
print "</TD>";
print "<TD WIDTH=8></TD>";
print "<TD><CODE>";
$anchor_num = 0;
while (<RCSDIFF>) {
# Get one command from the diff file
if (/^(c|a)(\d+)/) {
$line = $2;
while (<RCSDIFF>) {
last if /^\.$/;
}
} elsif (/^d(\d+)/) {
$line = $1;
} else {
print "<FONT SIZE=5 COLOR=#ffffff><B>Internal error:</B>",
" unknown command $_",
" at $. in $opt_file $opt_rev1\n";
}
print '&nbsp' x (4 - length($line));
print "<A TARGET='diff+$opt_file+$opt_rev1+$opt_rev2'",
" HREF=$magic_url&command=DIFF";
print "&root=$opt_root" if defined($opt_root);
print "&file=$opt_file&rev1=$opt_rev1&rev2=$opt_rev2#$anchor_num",
" ONCLICK='anchor = $anchor_num'>$line</A> ";
$anchor_num++;
}
close(RCSDIFF);
print '</TD></TR></TABLE>';
print "</FORM></BODY>\n";
}
# Default tab width, although it's frequently 4.
$tab_width = 8;
sub next_tab_stop {
local ($pos) = @_;
return int(($pos + $tab_width) / $tab_width) * $tab_width;
}
#
# Look for the magic emacs tab width comment, or for long lines with more
# than 4 leading tabs in more than 50% of the lines that start with a tab.
# In the latter case, set $tab_width to 4.
#
sub guess_tab_width {
local ($opt_file) = @_;
local ($found_tab_width) = 0;
local ($many_tabs, $any_tabs) = (0, 0);
open(RCSFILE, "$opt_file");
while (<RCSFILE>) {
if (/tab-width: (\d)/) {
$tab_width = $1;
$found_tab_width = 1;
last;
}
if (/^(\t+)/) {
$many_tabs++ if (length($1) >= 4);
$any_tabs++;
}
}
if (!$found_tab_width && $many_tabs > $any_tabs / 2) {
$tab_width = 4;
}
close(RCSFILE);
}
# Create gdiff-like output.
sub do_diff {
print "<HTML><HEAD>";
print "<TITLE>$opt_file: $opt_rev1 vs. $opt_rev2</TITLE>\n";
print "</HEAD>";
print "<BODY BGCOLOR=\"$diff_bg_color\" TEXT=\"#000000\"";
print " LINK=\"#0000EE\" VLINK=\"#551A8B\" ALINK=\"#FF0000\">";
chdir($dir);
local ($rcsfile) = "$opt_file,v";
$rcsfile = "Attic/$opt_file,v" if (! -r $rcsfile);
&guess_tab_width($rcsfile);
&html_diff($rcsfile, $opt_rev1, $opt_rev2);
print "\n</BODY>\n";
}
# Show specified CVS log entry.
sub do_log {
chdir($dir);
print "<TITLE>$opt_file: $opt_rev CVS log entry</TITLE>\n";
print '<PRE>';
open(RCSLOG, "rlog -r$opt_rev $opt_file |");
while (<RCSLOG>) {
last if (/^revision $opt_rev$/);
}
while (<RCSLOG>) {
last if (/^===============================================/);
print "$_<BR>";
}
close(RCSLOG);
print '</PRE>';
}
#
# Main script: generate a table of revision diff and log message hotlinks
# for each modified file in $opt_subdir, and a form for choosing a file and any
# two of its revisions.
#
sub do_directory {
$output = "<DIV ALIGN=LEFT>";
foreach $path (split('/',$opt_subdir)) {
$link_path .= $path;
$output .= "<A HREF='rview.cgi?dir=$link_path";
$output .= "&cvsroot=$opt_root" if defined $opt_root;
$output .= "&rev=$opt_branch" if $opt_branch;
$output .= "' onmouseover='window.status=\"Browse $link_path\";"
." return true;'>$path</A>/ ";
$link_path .= '/';
}
chop ($output);
if ($opt_branch) {
$output .= "<BR>Branch: $opt_branch";
}
$output .= "</DIV>";
EmitHtmlHeader("CVS Differences", $output);
chdir($dir);
print "<TABLE BORDER CELLPADDING=2>\n";
foreach $file (split(/\+/, $opt_files)) {
local ($path) = "$dir/$file,v";
$path = "$dir/Attic/$file,v" if (! -r $path);
&parse_rcs_file($path);
my $lxr_base = "http://cvs-mirror.mozilla.org/webtools/lxr/source";
# total kludge!! lxr omits the top-level "mozilla" directory...
my $lxr_path = "$opt_subdir/$file";
$lxr_path =~ s@^ns/@@;
$lxr_path =~ s@^mozilla/@@;
my $lxr_link = "$lxr_base/$lxr_path";
print "<TR><TD NOWRAP><B>";
print "<A HREF=\"$lxr_link\">$file</A><BR>";
print "<A HREF=\"cvslog.cgi?file=$opt_subdir/$file\">Change Log</A>\n";
print "</B></TD>\n";
if ($opt_branch) {
$first_rev = &map_tag_to_revision($opt_branch);
&die("$0: error: -r: No such revision: $opt_branch\n")
if ($first_rev eq '');
} else {
$first_rev = $head_revision;
}
$skip = $opt_skip;
$revs_remaining = $MAX_REVS;
for ($rev = $first_rev; $rev; $rev = $prev) {
$prev = $prev_revision{$rev};
next if $skip-- > 0;
if (!$revs_remaining--) {
#print '<TD ROWSPAN=2 VALIGN=TOP>';
print '<TD VALIGN=TOP>';
print "<A HREF=$magic_url&command=DIRECTORY";
print "&root=$opt_root" if defined($opt_root);
print "&files=$opt_files&branch=$opt_branch&skip=", $opt_skip + $MAX_REVS, "><i>Prior revisions</i></A>", "</TD>\n";
last;
}
my $href_open = "";
my $href_close = "";
if ( $prev && $rev ) {
$href_open = "<A HREF=$magic_url&command=DIFF_FRAMESET";
$href_open .= "&root=$opt_root" if defined($opt_root);
$href_open .= "&file=$file&rev1=$prev&rev2=$rev>";
$href_close = "</A>";
}
print "<TD>$href_open$rev$href_close<BR>";
print "$revision_author{$rev}</TD>";
}
print "</TR>\n";
if (0) {
print "<TR>\n";
$skip = $opt_skip;
$revs_remaining = $MAX_REVS;
for ($rev = $first_rev; $rev; $rev = $prev_revision{$rev}) {
next if $skip-- > 0;
last if !$revs_remaining--;
print "<TD><A HREF=$magic_url&command=LOG";
print "root=$opt_root" if defined($opt_root);
print "&file=$file&rev=$rev>$revision_author{$rev}</A>",
"</TD>\n";
}
print "</TR>\n";}
}
print "</TABLE><SPACER TYPE=VERTICAL SIZE=20>\n";
print '<FORM METHOD=get>';
print '<INPUT TYPE=hidden NAME=command VALUE=DIFF>';
print "<INPUT TYPE=hidden NAME=subdir VALUE=$opt_subdir>";
print '<FONT SIZE=+1><B>New Query:</B></FONT>';
print '<UL><TABLE BORDER=1 CELLSPACING=0 CELLPADDING=7><TR><TD>';
# pick something remotely sensible to put in the "Filename" field.
my $file = $opt_file;
if ( !$file && $opt_files ) {
$file = $opt_files;
$file =~ s@\+.*@@;
}
print "\n<TABLE CELLPADDING=0 CELLSPACING=0><TR><TD>\n",
'Filename:',
'</TD><TD>',
'<INPUT TYPE=text NAME=file VALUE="', $file, '" SIZE=40>',
"\n</TD></TR><TR><TD>\n",
'Old version:',
'</TD><TD>',
'<INPUT TYPE=text NAME=rev1 VALUE="', $opt_rev1, '" SIZE=20>',
"\n</TD></TR><TR><TD>\n",
'New version:',
'</TD><TD>',
'<INPUT TYPE=text NAME=rev2 VALUE="', $opt_rev2, '" SIZE=20>',
"\n</TD></TR></TABLE>\n";
print '<TABLE BORDER=0 CELLPADDING=5 WIDTH="100%"><TR><TD>',
'<INPUT TYPE=radio NAME=whitespace_mode VALUE="show" CHECKED>',
' Show Whitespace',
'<BR><INPUT TYPE=radio NAME=whitespace_mode VALUE="ignore">',
' Ignore Whitespace',
'</TD><TD>',
'<INPUT TYPE=radio NAME=diff_mode VALUE="context" CHECKED>',
' Context Diffs',
'<BR><INPUT TYPE=radio NAME=diff_mode VALUE="full">',
' Full Source Diffs';
print '</TD></TR></TABLE>';
print "<INPUT TYPE=submit>\n";
print '</TD></TR></TABLE></UL>';
print "</FORM>\n";
&print_bottom;
}
#
# This function generates a gdiff-style, side-by-side display using HTML.
# It requires two arguments, each of which must be an open filehandle.
# The first filehandle, DIFF, must be a `diff -f` style output containing
# commands to convert the contents of the second filehandle, OLDREV, into
# a later version of OLDREV's file.
#
sub html_diff {
local ($file, $rev1, $rev2) = @_;
local ($old_line_num) = 1;
open(DIFF, "$rcsdiff -f -r$rev1 -r$rev2 $file 2>/dev/null |");
open(OLDREV, "/tools/ns/bin/co -p$rev1 $file 2>/dev/null |");
$anchor_num = 0;
if ($ENV{'HTTP_USER_AGENT'} =~ /Win/) {
$font_tag = "<PRE><FONT FACE='Lucida Console' SIZE=-1>";
} else {
# We don't want your stinking Windows font
$font_tag = "<PRE>";
}
print "<TABLE BGCOLOR=$stable_bg_color "
.'CELLPADDING=0 CELLSPACING=0 WIDTH="100%" COLS=2>';
print "<TR BGCOLOR=$header_bg_color><TH>Version $rev1<TH>Version $rev2</TR>";
while (<DIFF>) {
$mark = 0;
if (/^a(\d+)/) {
$point = $1;
&skip_to_line($point + 1, *OLDREV, *old_line_num);
while (<DIFF>) {
last if (/^\.$/);
&print_row('', $stable_bg_color, $_, $addition_bg_color);
}
} elsif ((($point, $mark) = /^c(\d+) (\d+)$/) ||
(($point) = /^c(\d+)$/)) {
$mark = $point if (!$mark);
&skip_to_line($point, *OLDREV, *old_line_num);
while (<DIFF>) {
last if (/^\.$/);
if ($old_line_num <= $mark) {
$old_line = <OLDREV>;
$old_line_num++;
} else {
$old_line = ''
}
&print_row($old_line, $change_bg_color, $_, $change_bg_color);
}
while ($old_line_num <= $mark) {
$old_line = <OLDREV>;
$old_line_num++;
&print_row($old_line, $change_bg_color, '', $change_bg_color);
}
} elsif ((($point, $mark) = /^d(\d+) (\d+)$/) ||
(($point) = /^d(\d+)$/)) {
$mark = $point if (!$mark);
&skip_to_line($point, *OLDREV, *old_line_num);
while ($old_line = <OLDREV>) {
$old_line_num++;
&print_row($old_line, $deletion_bg_color, '', $stable_bg_color);
last if ($. == $mark);
}
} else {
print "</TABLE><FONT SIZE=5 COLOR=#ffffff><B>Internal error:</B>",
" unknown command $_",
" at $. in $opt_file $opt_rev1\n";
exit;
}
}
#
# Print the remaining lines in the original file. These are lines that
# were not modified in the later revision
#
local ($base_old_line_num) = $old_line_num;
while ($old_line = <OLDREV>) {
$old_line_num++;
&print_row($old_line, $stable_bg_color, $old_line, $stable_bg_color)
if ($opt_diff_mode eq 'full' ||
$old_line_num <= $base_old_line_num + 5);
}
# print "</FONT></PRE>\n";
print "</TABLE></FONT>\n";
&print_bottom;
close(OLDREV);
close(DIFF);
}
sub skip_to_line {
local ($line_num, *OLDREV, *old_line_num) = @_;
local ($anchor_printed) = 0;
local ($skip_line_printed) = ($line_num - $old_line_num <= 10);
local ($base_old_line_num) = $old_line_num;
while ($old_line_num < $line_num) {
if (!$anchor_printed && $old_line_num >= $line_num - 10) {
print "\n<A NAME=$anchor_num>";
$anchor_printed = 1;
}
if ($opt_diff_mode eq 'context' && !$skip_line_printed &&
$line_num - 5 <= $old_line_num) {
print "\n</TABLE>\n";
print "<TABLE BGCOLOR=$stable_bg_color "
.'CELLPADDING=0 CELLSPACING=0 WIDTH="100%" COLS=2>';
print "<TR BGCOLOR=$skipping_bg_color><TD>",
"<B>Skipping to line $old_line_num:</B><TD>&nbsp;";
$skip_line_printed = 1;
}
$old_line = <OLDREV>;
$old_line_num++;
&print_row($old_line, $stable_bg_color, $old_line, $stable_bg_color)
if ($opt_diff_mode eq 'full' ||
$old_line_num <= $base_old_line_num + 5 ||
$line_num - 5 < $old_line_num);
}
print "<A NAME=$anchor_num>" if (!$anchor_printed);
print '</A>';
$anchor_num++;
}
sub print_cell {
local ($line, $color) = @_;
local ($i, $j, $k, $n);
local ($c, $newline);
if ($color eq $stable_bg_color) {
print "<TD>$font_tag";
} else {
print "<TD BGCOLOR=$color>$font_tag";
}
while (($c = substr($line, -1)) && ($c eq "\n" || $c eq "\r")) {
chop $line;
}
$n = length($line);
$newline = '';
for ($i = $j = 0; $i < $n; $i++) {
$c = substr($line, $i, 1);
if ($c eq "\t") {
for ($k = &next_tab_stop($j); $j < $k; $j++) {
$newline .= ' ';
}
} else {
$newline .= $c;
$j++;
}
}
$newline =~ s/&/&amp;/g;
$newline =~ s/</&lt;/g;
$newline =~ s/>/&gt;/g;
if (length($newline) <= 80) {
$newline = sprintf("%-80.80s", $newline);
} else {
$newline =~ s/([^\n\r]{80})([^\n\r]*)/$1\n$2/g;
}
print $newline;
}
sub print_row {
local ($line1, $color1, $line2, $color2) = @_;
print "\n<TR>";
&print_cell($line1, $color1);
&print_cell($line2, $color2);
}
sub print_bottom {
print <<__BOTTOM__;
<P>
<TABLE BORDER=0 CELLSPACING=0 CELLPADDING=0><TR><TD>
<HR>
<TR><TD>
<FONT SIZE=-1>
&nbsp;&nbsp;Mail feedback and feature requests to <A HREF="mailto:slamm\@netscape.com?subject=About the cvs differences script">slamm</A>.&nbsp;&nbsp;
</TABLE>
</BODY>
</HTML>
__BOTTOM__
} # print_bottom
sub do_cmd {
if ($opt_command eq 'DIFF_FRAMESET') { do_diff_frameset; }
elsif ($opt_command eq 'DIFF_LINKS') { do_diff_links; }
elsif ($opt_command eq 'DIFF') { do_diff; }
elsif ($opt_command eq 'LOG') { do_log; }
elsif ($opt_command eq 'DIRECTORY') { do_directory; }
else { print "invalid command \"$opt_command\"."; }
exit;
}
do_cmd;

131
webtools/bonsai/doadmin.cgi Executable file
Просмотреть файл

@ -0,0 +1,131 @@
#!/usr/bonsaitools/bin/mysqltcl
# -*- Mode: tcl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Bonsai CVS tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
source CGI.tcl
source adminfuncs.tcl
puts "Content-type: text/html
"
CheckPassword $FORM(password)
Lock
LoadCheckins
switch -exact -- $FORM(command) {
close {
AdminCloseTree [ParseTimeAndCheck [FormData closetimestamp]]
puts "
<TITLE>Clang!</TITLE>
<H1>The tree is now closed.</H1>
Mail has been sent notifying \"the hook\" and anyone subscribed to
bonsai-treeinterest.
<P>
<a href=\"mailto:clienteng?subject=The tree is now closed.\">Click here</a>
to send e-mail about it to clienteng.
"
}
open {
AdminOpenTree [ParseTimeAndCheck [FormData lastgood]] \
[info exists FORM(doclear)]
puts "
<TITLE>The floodgates are open.</TITLE>
<H1>The tree is now open.</H1>
Mail has been sent notifying \"the hook\" and anyone subscribed to
bonsai-treeinterest.
<a href=\"mailto:clienteng?subject=The tree is now opened.\">Click here</a>
to send e-mail about it to clienteng.
"
}
tweaktimes {
set lastgoodtimestamp [ParseTimeAndCheck [FormData lastgood]]
set closetimestamp [ParseTimeAndCheck [FormData lastclose]]
puts "
<TITLE>Let's do the time warp again...</TITLE>
<H1>Times have been tweaked.</H1>
"
Log "Times tweaked: lastgood is [MyFmtClock $lastgoodtimestamp], closetime is [MyFmtClock $closetimestamp]"
}
editmotd {
LoadMOTD
if {![cequal [FormData origmotd] $motd]} {
puts "
<TITLE>Oops!</TITLE>
<H1>Someone else has been here!</H1>
It looks like somebody else has changed the message-of-the-day.
Terry was too lazy to implement anything beyond detecting this
condition. You'd best go start over -- go back to the top of Bonsai,
look at the current message-of-the-day, and decide if you still
want to make your edits."
PutsTrailer
exit
}
MailDiffs "message-of-the-day" $motd [FormData motd]
set motd [FormData motd]
puts "
<TITLE>New MOTD</TITLE>
<H1>The message-of-the-day has been changed.</H1>
"
WriteMOTD
Log "New motd: $motd"
}
changepassword {
if {![cequal $FORM(newpassword) $FORM(newpassword2)]} {
puts "
<TITLE>Oops!</TITLE>
<H1>Mismatch!</H1>
The two passwords you typed didn't match. Click <b>Back</b> and try again."
PutsTrailer
exit
}
if {$FORM(doglobal)} {
CheckGlobalPassword
set outfile data/passwd
} else {
set outfile "[DataDir]/treepasswd"
}
set encoded [string trim [exec ./data/trapdoor $FORM(newpassword)]]
set fid [open $outfile "w"]
puts $fid $encoded
close $fid
catch {chmod 0777 $outfile}
puts "
<TITLE>Locksmithing complete.</TITLE>
<H1>Password changed.</H1>
The new password is now in effect."
PutsTrailer
exit
}
}
PutsTrailer
WriteCheckins
Unlock
exit

103
webtools/bonsai/doeditcheckin.cgi Executable file
Просмотреть файл

@ -0,0 +1,103 @@
#!/usr/bonsaitools/bin/mysqltcl
# -*- Mode: tcl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Bonsai CVS tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
source CGI.tcl
puts "Content-type: text/html
<HTML>"
CheckPassword $FORM(password)
Lock
LoadCheckins
set busted 0
if {![info exists $FORM(id)]} {
set busted 1
} else {
upvar #0 $FORM(id) info
if {![info exists info(notes)]} {
set info(notes) ""
}
foreach i [lsort [array names info]] {
if {![cequal [FormData "orig$i"] $info($i)]} {
set busted 1
set text "Key $i -- orig is [FormData "orig$i"], new is $info($i)"
break
}
}
}
if {$busted} {
Unlock
puts "
<TITLE>Oops!</TITLE>
<H1>Someone else has been here!</H1>
It looks like somebody else has changed or deleted this checkin.
Terry was too lazy to implement anything beyond detecting this
condition. You'd best go start over -- go back to the list of
checkins, look for this checkin again, and decide if you still want to
make your edits."
PutsTrailer
exit
}
proc ParseTimeAndCheck {timestr} {
if {[catch {set result [convertclock $timestr]}]} {
puts "
<TITLE>Time trap</TITLE>
<H1>Can't grok the time</H1>
You entered a time of <tt>$timestr</tt>, and I can't understand it. Please
hit <B>Back</B> and try again."
exit
}
return $result
}
if {[info exists FORM(nukeit)]} {
Log "A checkin for $info(person) has been nuked."
} else {
Log "A checkin for $info(person) has been modified."
}
set info(date) [ParseTimeAndCheck [FormData datestring]]
foreach i {person dir files notes treeopen log} {
set info($i) [FormData $i]
}
if {[info exists FORM(nukeit)]} {
set w [lsearch -exact $checkinlist $FORM(id)]
if {$w >= 0} {
set checkinlist [lreplace $checkinlist $w $w]
}
}
WriteCheckins
puts "OK, the checkin has been changed."
PutsTrailer
exit

74
webtools/bonsai/doeditmessage.cgi Executable file
Просмотреть файл

@ -0,0 +1,74 @@
#!/usr/bonsaitools/bin/mysqltcl
# -*- Mode: tcl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Bonsai CVS tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
source CGI.tcl
puts "Content-type: text/html
"
CheckPassword $FORM(password)
set filename $FORM(msgname)
set fullfilename [DataDir]/$filename
Lock
if {[file exists $fullfilename]} {
set text [read_file $fullfilename]
} else {
set text {}
}
if {![cequal [FormData origtext] $text]} {
puts "
<TITLE>Oops!</TITLE>
<H1>Someone else has been here!</H1>
It looks like somebody else has changed this message while you were editing it.
Terry was too lazy to implement anything beyond detecting this
condition. You'd best go start over -- go back to the top of Bonsai,
work your way back to editing the message, and decide if you still
want to make your edits."
PutsTrailer
exit
}
set text [FormData text]
set fid [open $fullfilename "w"]
puts $fid $text
catch {chmod 0666 $fullfilename }
close $fid
Log "$filename set to $text"
Unlock
puts "
<TITLE>New $filename</TITLE>
<H1>The file <b>$filename</b> has been changed.</H1>
"
PutsTrailer
exit

0
webtools/bonsai/doeditprofile.cgi Executable file
Просмотреть файл

83
webtools/bonsai/doeditwhiteboard.cgi Executable file
Просмотреть файл

@ -0,0 +1,83 @@
#!/usr/bonsaitools/bin/mysqltcl
# -*- Mode: tcl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Bonsai CVS tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
source CGI.tcl
Lock
LoadWhiteboard
set oldvalue [FormData origwhite]
if {![cequal $oldvalue $whiteboard]} {
Unlock
puts "Content-type: text/html
<TITLE>Error -- pen stolen.</TITLE>
<H1>Someone else just changed the whiteboard.</H1>
Somebody else has changed what's on the whiteboard. Your changes will
stomp over theirs.
<P>
The whiteboard now reads:
<hr>
<PRE VARIABLE>$whiteboard</PRE>
<hr>
If you really want to change the whiteboard to your text, click the button
below. Or maybe you want to tweak your text first. Or you can forget it and
go back to the beginning.
<FORM method=get action=\"doeditwhiteboard.cgi\">
<INPUT TYPE=HIDDEN NAME=origwhite VALUE=\"[value_quote $whiteboard]\">
Change the free-for-all whiteboard:<br>
<TEXTAREA NAME=whiteboard ROWS=10 COLS=70>[FormData whiteboard]</TEXTAREA><BR>
<INPUT TYPE=SUBMIT VALUE=\"Change the Whiteboard\">
</FORM>
"
PutsTrailer
exit
}
set newwhiteboard [string trimright [FormData whiteboard]]
MailDiffs "whiteboard" $whiteboard $newwhiteboard
set whiteboard $newwhiteboard
WriteWhiteboard
Unlock
puts "
<TITLE>Where's my blue marker?</TITLE>
<H1>The whiteboard has been changed.</H1>
The whiteboard now reads:
<hr>
<PRE VARIABLE>$whiteboard</PRE>
"
Log "Whiteboard changed to be: $whiteboard"
PutsTrailer
exit

220
webtools/bonsai/dolog.pl Executable file
Просмотреть файл

@ -0,0 +1,220 @@
#!/usr/bonsaitools/bin/perl --
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Bonsai CVS tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
$cvsroot = substr(<STDIN>, 0, -1);
$flag_debug = 0;
$flag_tagcmd = 0;
$repository = substr(<STDIN>, 0, -1);
$repository_tag = '';
@mailto=();
@changed_files = ();
@added_files = ();
@removed_files = ();
@log_lines = ();
@outlist = ();
$STATE_NONE = 0;
$STATE_CHANGED = 1;
$STATE_ADDED = 2;
$STATE_REMOVED = 3;
$STATE_LOG = 4;
&process_args;
if ($flag_debug ){
print STDERR "----------------------------------------------\n";
print STDERR "LOGINFO:\n";
print STDERR " pwd:" . `pwd` . "\n";
print STDERR " Args @ARGV\n";
print STDERR " CVSROOT: $cvsroot\n";
print STDERR " Repository: $repository\n";
print STDERR " mailto: @mailto\n";
print STDERR "----------------------------------------------\n";
}
if ($flag_tagcmd) {
&process_tag_command;
} else {
&get_loginfo;
&process_cvs_info;
}
if( $flag_debug){
print STDERR "----------------------------------------------\n";
print STDERR @outlist;
print STDERR "----------------------------------------------\n";
}
&mail_notification;
0;
sub process_args {
while (@ARGV) {
$arg = shift @ARGV;
if ($arg eq '-d') {
$flag_debug = 1;
print STDERR "Debug turned on...\n";
} elsif ($arg eq '-t') {
$flag_tagcmd = 1;
last; # Keep the rest in ARGV; they're handled later.
} else {
push(@mailto, $arg);
}
}
if( $repository eq '' ){
open( REP, "<CVS/Repository");
$repository = <REP>;
chop($repository);
close(REP);
}
$repository =~ s:^$cvsroot/::;
if (!$flag_tagcmd) {
if( open( REP, "<CVS/Tag") ) {
$repository_tag = <REP>;
chop($repository_tag);
close(REP);
}
}
}
sub get_loginfo {
if( $flag_debug){
print STDERR "----------------------------------------------\n";
}
# Iterate over the body of the message collecting information.
#
$state = $STATE_NONE;
while (<STDIN>) {
chop; # Drop the newline
if (/^__BONSAI__SEPARATOR__MAGIC__$/) {
last;
}
if( $flag_debug){
print STDERR "$_\n";
}
if (/^In directory/) {
next;
}
if (/^Modified Files/) { $state = $STATE_CHANGED; next; }
if (/^Added Files/) { $state = $STATE_ADDED; next; }
if (/^Removed Files/) { $state = $STATE_REMOVED; next; }
if (/^Log Message/) { $state = $STATE_LOG; next; }
s/^[ \t\n]+//; # delete leading whitespace
s/[ \t\n]+$//; # delete trailing whitespace
if ($state == $STATE_CHANGED) { push(@changed_files, split); }
if ($state == $STATE_ADDED) { push(@added_files, split); }
if ($state == $STATE_REMOVED) { push(@removed_files, split); }
if ($state == $STATE_LOG) { push(@log_lines, $_); }
}
if( $flag_debug){
print STDERR "----------------------------------------------\n"
. "changed files: @changed_files\n"
. "added files: @added_files\n"
. "removed files: @removed_files\n";
print STDERR "----------------------------------------------\n";
}
}
sub process_cvs_info {
local($d,$fn,$rev,$mod_time,$sticky,$tag,$stat,@d,$rcsfile);
$time = time;
while( <STDIN> ){ # Parsing the Entries file, actually.
chop;
$fn = "";
($d,$fn,$rev,$mod_time,$sticky,$tag) = split(/\//);
$stat = 'C';
for $i (@changed_files, "BEATME.NOW", @added_files ) {
if( $i eq "BEATME.NOW" ){ $stat = 'A'; }
if($i eq $fn ){
$rcsfile = "$cvsroot/$repository/$fn,v";
if( ! -r $rcsfile ){
$rcsfile = "$cvsroot/$repository/Attic/$fn,v";
}
open(LOG, "/tools/ns/bin/rlog -N -r$rev $rcsfile |")
|| print STDERR "dolog.pl: Couldn't run rlog\n";
$username = "nobody";
$lines_added = 0;
$lines_removed = 0;
while(<LOG>){
if (/^date:.* author: ([^;]*);.*/) {
$username = $1;
if (/lines: \+([0-9]*) -([0-9]*)/) {
$lines_added = $1;
$lines_removed = $2;
}
}
}
close( LOG );
push(@outlist, ("$stat|$time|$username|$cvsroot|$repository|$fn|$rev|$sticky|$tag|+$lines_added|-$lines_removed\n"));
}
}
}
for $i (@removed_files) {
push( @outlist, ("R|$time|$username|$cvsroot|$repository|$i|||$repository_tag\n"));
}
push (@outlist, "LOGCOMMENT\n");
push (@outlist, join("\n",@log_lines));
push (@outlist, "\n:ENDLOGCOMMENT\n");
}
sub process_tag_command {
local($str,$part,$time);
$time = time;
$str = "Tag|$cvsroot|$time";
while (@ARGV) {
$part = shift @ARGV;
$str .= "|" . $part;
}
push (@outlist, ("$str\n"));
}
sub do_commitinfo {
}
sub mail_notification {
my $filename = "data/temp.$$";
open(OUT, ">$filename") || die "Couldn't open output file.";
print OUT "dummy: line preteending to be mail headers\n\n";
print OUT @outlist, "\n";
close OUT;
system "./addcheckin.tcl $filename";
# rm $filename;
}

121
webtools/bonsai/dotweak.cgi Executable file
Просмотреть файл

@ -0,0 +1,121 @@
#!/usr/bonsaitools/bin/mysqltcl
# -*- Mode: tcl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Bonsai CVS tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
source CGI.tcl
puts "Content-type: text/html
<HTML>"
CheckPassword $FORM(password)
Lock
LoadCheckins
if {![info exists FORM(command)]} {
set FORM(command) nocommand
}
set list {}
foreach i [array names FORM] {
switch -glob -- $i {
{checkin-*} {
if {[lsearch -exact $checkinlist $i] >= 0} {
lappend list $i
}
}
}
}
set origtree $treeid
switch -exact -- $FORM(command) {
nuke {
foreach i $list {
set w [lsearch -exact $checkinlist $i]
if {$w >= 0} {
set checkinlist [lreplace $checkinlist $w $w]
}
}
set what "deleted."
}
setopen {
foreach i $list {
upvar #0 $i info
set info(treeopen) 1
}
set what "modified to be open."
}
setclose {
foreach i $list {
upvar #0 $i info
set info(treeopen) 0
}
set what "modified to be closed."
}
movetree {
if {[cequal $treeid $FORM(desttree)]} {
puts "<H1>Pick a different tree</H1>"
puts "You attempted to move checkins into the tree that they're"
puts "already in. Hit <b>Back</b> and try again."
PutsTrailer
exit
}
foreach i $list {
set w [lsearch -exact $checkinlist $i]
if {$w >= 0} {
set checkinlist [lreplace $checkinlist $w $w]
}
}
WriteCheckins
unset checkinlist
set treeid $FORM(desttree)
unset batchid
LoadCheckins
LoadTreeConfig
foreach i $list {
lappend checkinlist $i
}
set what "moved to the $treeinfo($treeid,description) tree."
}
default {
puts "<h1>No command selected</h1>"
puts "You need to select one of the radio command buttons at the"
puts "bottom. Hit <b>Back</b> and try again."
PutsTrailer
exit
}
}
WriteCheckins
Unlock
puts "
<H1>OK, done.</H1>
The selected checkins have been $what"
set treeid $origtree
PutsTrailer
exit

91
webtools/bonsai/editcheckin.cgi Executable file
Просмотреть файл

@ -0,0 +1,91 @@
#!/usr/bonsaitools/bin/mysqltcl
# -*- Mode: tcl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Bonsai CVS tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
source CGI.tcl
LoadCheckins
upvar #0 $FORM(id) info
puts "Content-type: text/html
<HTML>
<TITLE>Say the magic word.</TITLE>
<H1>Edit a checkin.</H1>
Congratulations, you have found the hidden edit-a-checkin feature. Of course,
you need to know the magic word to do anything from here.
<P>
<FORM method=get action=\"doeditcheckin.cgi\">
<TABLE>
<tr>
<td align=right><B>Password:</B></td>
<td><INPUT NAME=password TYPE=password></td>
</tr><tr>
<td align=right><B>When:</B></td>
<td><INPUT NAME=datestring VALUE=\"[value_quote [MyFmtClock $info(date)]]\">
</td></tr>
"
if {![info exists info(notes)]} {
set info(notes) ""
}
foreach i {person dir files notes} {
puts "<tr><td align=right><B>$i:</B></td>"
puts "<td><INPUT NAME=$i VALUE=\"[value_quote $info($i)]\"></td></tr>"
}
proc CheckString {value} {
if {$value} {
return "CHECKED"
} else {
return ""
}
}
puts "
<tr><td align=right><b>Tree state:</b></td>
<td><INPUT TYPE=radio NAME=treeopen VALUE=1 [CheckString $info(treeopen)]>Open
</td></tr><tr><td></td>
<td><INPUT TYPE=radio NAME=treeopen VALUE=0 [CheckString [expr !$info(treeopen)]]>Closed
</td></tr><tr>
<td align=right valign=top><B>Log message:</B></td>
<td><TEXTAREA NAME=log ROWS=10 COLS=80>$info(log)</TEXTAREA></td></tr>
</table>
<INPUT TYPE=CHECKBOX NAME=nukeit>Check this box to blow away this checkin entirely.<br>
<INPUT TYPE=SUBMIT VALUE=Submit>"
foreach i [lsort [array names info]] {
puts "<INPUT TYPE=HIDDEN NAME=orig$i VALUE=\"[value_quote $info($i)]\">"
}
puts "<INPUT TYPE=HIDDEN NAME=id VALUE=\"[value_quote $FORM(id)]\">"
puts "<INPUT TYPE=HIDDEN NAME=treeid VALUE=\"[value_quote $treeid]\">"
puts "</TABLE></FORM>"
PutsTrailer
exit

99
webtools/bonsai/editmessage.cgi Executable file
Просмотреть файл

@ -0,0 +1,99 @@
#!/usr/bonsaitools/bin/mysqltcl
# -*- Mode: tcl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Bonsai CVS tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
source CGI.tcl
puts "Content-type: text/html
<html>
<head>
<title>We don't need no stinkin' HTML compose window</title>
</head>
<body>
<h1>Message editor</h1>"
set filename $FORM(msgname)
set fullfilename [DataDir]/$filename
if {[file exists $fullfilename]} {
set text [read_file $fullfilename]
} else {
set text {}
}
puts "
Below is the template for the <b>$filename</b> message. Type the
magic word and edit at will, but be careful to not break anything,
especially around the headers.
The following magic symbols exist:
<table>"
proc PutDoc {name desc} {
puts "<tr>"
puts "<td align=right><tt><b>%$name%</b></tt></td>"
puts "<td>Replaced by the $desc</td>"
puts "</tr>"
}
switch -exact -- $filename {
openmessage -
closemessage {
PutDoc name "username of the person getting mail"
PutDoc dir "directory for this checkin"
PutDoc files "list of files for this checkin"
PutDoc log "log message for this checkin"
PutDoc profile "profile for this user"
}
treeopened -
treeopenedsamehook -
treeclosed {
PutDoc "hooklist" "comma-separated list of e-mail address of people on the hook"
}
default {
puts "</table><P><font color=red>Uh, hey, this isn't a legal file for"
puts "you to be editing here!</font>"
PutsTrailer
exit
}
}
puts "
</TABLE>
<FORM method=get action=\"doeditmessage.cgi\">
<INPUT TYPE=HIDDEN NAME=treeid VALUE=$treeid>
<B>Password:</B> <INPUT NAME=password TYPE=password> <BR>
<INPUT TYPE=HIDDEN NAME=msgname VALUE=$filename>
<INPUT TYPE=HIDDEN NAME=origtext VALUE=\"[value_quote $text]\">
<TEXTAREA NAME=text ROWS=40 COLS=80>$text</TEXTAREA><BR>
<INPUT TYPE=SUBMIT VALUE=\"Change this message\">
</FORM>
"
PutsTrailer
exit

0
webtools/bonsai/editprofile.cgi Executable file
Просмотреть файл

45
webtools/bonsai/editwhiteboard.cgi Executable file
Просмотреть файл

@ -0,0 +1,45 @@
#!/usr/bonsaitools/bin/mysqltcl
# -*- Mode: tcl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Bonsai CVS tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
source CGI.tcl
LoadWhiteboard
puts "Content-type: text/html
<TITLE>Scritch, scritch.</TITLE>
<FORM method=post action=\"doeditwhiteboard.cgi\">
<INPUT TYPE=HIDDEN NAME=treeid VALUE=$treeid>
<INPUT TYPE=HIDDEN NAME=origwhite VALUE=\"[value_quote $whiteboard]\">
The free-for-all whiteboard is a fine place to put notes of general
and temporary interest about the tree. (Like, \"I'm checking in a bunch
of nasty stuff; stay out of the tree until 3:30pm\".)
<P>
Change the free-for-all whiteboard:<br>
<TEXTAREA NAME=whiteboard ROWS=10 COLS=70>$whiteboard</TEXTAREA><BR>
<INPUT TYPE=SUBMIT VALUE=\"Change the Whiteboard\">
</FORM>
"
PutsTrailer
exit

672
webtools/bonsai/globals.tcl Executable file
Просмотреть файл

@ -0,0 +1,672 @@
# -*- Mode: tcl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Bonsai CVS tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
# What some of the global variables mean:
# lastgoodtimestamp -- the timestamp when we last knew we had a good tree.
# closetimestamp -- when the tree was closed. When we open, it probably
# becomes the lastgoodtimestamp
set ldapserver directory.mcom.com
# set ldapserver hoth.mcom.com
set ldapport 389
if {![info exists env(TZ)] || [cequal $env(TZ) ""]} {
# Shouldn't have to do this! Something busted on warp, I think.
set env(TZ) PST8PDT
}
# BUGSYSTEMEXPR is something that may be redefined in data/configdata, which
# will define what to use in the replacement part of a regsub to quote bug
# numbers that appear in the system.
set BUGSYSTEMEXPR {<A HREF="http://scopus/bugsplat/show_bug.cgi?id=&">&</A>}
set treeid {default}
proc NOTDEF {foo} {
}
proc ConnectToDatabase {} {
global mysqlhandle
if {![info exists mysqlhandle]} {
set mysqlhandle [mysqlconnect]
mysqluse $mysqlhandle "bonsai"
}
}
proc SendSQL { str } {
# puts $str
global mysqlhandle errorInfo
if {[catch {mysqlsel $mysqlhandle $str} errmsg]} {
puts $str
error "$errmsg - $str" $errorInfo
}
return 0
}
proc MoreSQLData {} {
global mysqlhandle
set result [mysqlresult $mysqlhandle "rows?"]
return [expr ![cequal $result ""] && $result > 0]
}
proc FetchSQLData {} {
global mysqlhandle
return [mysqlnext $mysqlhandle]
}
proc SqlQuote {str} {
regsub -all "'" $str "''" str
#
# This next line is quoting hell. One level of quoting comes from
# the TCL interpreter, and another level comes from TCL's regular
# expression parser. It really works out to "change every
# backslash to two backslashes".
regsub -all "\\\\" $str "\\\\\\\\" str
return $str
}
proc GetId {table field value} {
global lastidcache
if {[info exists lastidcache($table)]} {
lassign lastidcache($table) cval id
if {[cequal $value $cval]} {
return $id
}
}
set qvalue [SqlQuote $value]
SendSQL "select id from $table where $field = '$qvalue'"
set result [lindex [FetchSQLData] 0]
if {[cequal $result ""]} {
SendSQL "insert into $table ($field) values ('$qvalue')"
SendSQL "select LAST_INSERT_ID()"
set result [lindex [FetchSQLData] 0]
}
set lastidcache($table) [list $value $result]
return $result
}
set lastdescription { }
set lastdescriptionid 0
proc AddToDatabase {lines desc} {
global lastdescription lastdescriptionid
if {[clength $desc] > 60000} {
set desc [crange $desc 0 60000]
}
set desc [string trimright $desc]
if {[cequal $desc $lastdescription]} {
set descid $lastdescriptionid
} else {
set descid {}
}
set basequery "replace into checkins(type,when,whoid,repositoryid,dirid,"
append basequery "fileid,revision,stickytag,branchid,addedlines,"
append basequery "removedlines,descid) values ("
foreach line [split $lines "\n"] {
if {[cequal $line ""]} {
continue
}
lassign [split $line "|"] chtype date name repository dir \
file version sticky branch addlines removelines
regsub {^T} $branch {} branch
regsub {/$} $dir {} dir
if {[cequal $addlines ""]} {
set addlines 0
}
if {[cequal $removelines ""]} {
set removelines 0
}
if {[catch {set removelines [expr abs($removelines)]}]} {
continue
}
if {[catch {set date [fmtclock $date {%Y-%m-%d %H:%M}]}]} {
continue
}
if {[cequal $descid ""]} {
set quoted [SqlQuote $desc]
SendSQL "select distinct descid from checkins,descs where when = '$date' and descs.id = descid and descs.description = '$quoted'"
if {![MoreSQLData]} {
SendSQL "insert into descs (description) values ('$quoted')"
SendSQL "select LAST_INSERT_ID()"
}
set descid [lindex [FetchSQLData] 0]
set lastdescriptionid $descid
set lastdescription $desc
}
set query $basequery
switch $chtype {
"C" {
append query "'Change'"
}
"A" {
append query "'Append'"
}
"R" {
append query "'Remove'"
}
default {
append query "NULL"
}
}
append query ",'$date'"
append query ",[GetId people who $name]"
append query ",[GetId repositories repository $repository]"
append query ",[GetId dirs dir $dir]"
append query ",[GetId files file $file]"
append query ",'[SqlQuote $version]'"
append query ",'[SqlQuote $sticky]'"
append query ",[GetId branches branch $branch]"
append query ",$addlines"
append query ",$removelines"
append query ",$descid)"
SendSQL $query
}
}
proc assert {arg} {
set result [uplevel 1 expr $arg]
if {!$result} {
error "Bad assertion $arg"
}
}
set lockcount 0
proc html_quote {var} {
regsub -all {&} "$var" {\&amp;} var
regsub -all {<} "$var" {\&lt;} var
regsub -all {>} "$var" {\&gt;} var
return $var
}
proc url_quote_char {c} {
scan $c "%c" value
if {$value <= 32 || [regexp {[ %=&?]} $c]} {
return [format "%%%02x" $value]
}
return $c
}
proc url_quote {var} {
set result ""
foreach c [split $var ""] {
append result [url_quote_char $c]
}
return $result
}
proc DataDir {} {
global treeid
if {[cequal $treeid "default"]} {
return data
} else {
return data/$treeid
}
}
proc Lock {} {
global lockcount lockfid
if {$lockcount <= 0} {
set lockcount 0
if {[catch {set lockfid [open "data/lockfile" "a"]}]} {
catch {mkdir data}
catch {chmod 0777 data}
set lockfid [open "data/lockfile" "a"]
}
flock -write $lockfid
catch {chmod 0666 data/lockfile}
}
incr lockcount
}
proc Unlock {} {
global lockcount lockfid
incr lockcount -1
if {$lockcount <= 0} {
funlock $lockfid
close $lockfid
}
}
proc LoadDirList {} {
global legaldirs treeid treeinfo
set legaldirs {}
if {![info exists treeinfo($treeid,repository)]} {
LoadTreeConfig
}
set modules $treeinfo($treeid,repository)/CVSROOT/modules
set dirsfile [DataDir]/legaldirs
if {[file exists $modules]} {
if {![file exists $dirsfile] ||
[file mtime $dirsfile] < [file mtime $modules]} {
catch {exec ./createlegaldirs.tcl $treeid}
}
}
Lock
for_file line $dirsfile {
lappend legaldirs $line
}
Unlock
}
proc PickNewBatchID {} {
global batchid
incr batchid
Lock
set fid [open [DataDir]/batchid "w"]
puts $fid "set batchid $batchid"
close $fid
Unlock
}
set readonly 0
proc LoadCheckins {} {
global batchid treeopen checkinlist
global lastgoodtimestamp closetimestamp
assert {![info exists checkinlist]}
Lock
if {![info exists batchid]} {
set filename "[DataDir]/batchid"
if {![file exists $filename]} {
set fid [open $filename "w"]
chmod 0666 $filename
puts $fid "set batchid 1"
close $fid
}
uplevel #0 source $filename
}
set filename [DataDir]/batch-$batchid
if {[file exists $filename]} {
uplevel #0 source $filename
}
Unlock
if {![info exists checkinlist]} {
set checkinlist {}
}
if {![info exists treeopen]} {
set treeopen 1
}
foreach t {lastgoodtimestamp closetimestamp} {
if {![info exists $t]} {
set $t [convertclock "1/1/70"]
}
}
}
proc WriteCheckins {} {
global batchid checkinlist treeopen readonly
global lastgoodtimestamp closetimestamp
if {$readonly} {
puts "<P><B><font color=red>Can't write checkins file; not viewing"
puts "current info.</font></b>"
return
}
set filename [DataDir]/temp-[id process]
set fid [open $filename "w"]
chmod 0666 $filename
# Hack to make person be an empty array:
set person(xyzzy) 1
unset person(xyzzy)
foreach i {treeopen lastgoodtimestamp closetimestamp checkinlist} {
puts $fid [list set $i [set $i]]
}
foreach c $checkinlist {
upvar #0 $c info
foreach i [lsort [array names info]] {
puts $fid [list set [set c]($i) $info($i)]
}
set person($info(person)) 1
}
close $fid
Lock
set filedest [DataDir]/batch-$batchid
if {[file exists $filedest]} {
unlink $filedest
}
frename $filename $filedest
set fid [open $filename "w"]
chmod 0666 $filename
foreach i [lsort [array names person]] {
puts $fid $i
}
puts $fid "bonsai-hookinterest@glacier"
puts $fid "mcom.dev.client.build.busted"
close $fid
frename $filename [DataDir]/hooklist
Unlock
}
proc ConstructMailTo {name subject} {
return "<a href=\"mailto:$name?subject=$subject\">Send mail to $name</a>"
}
proc Log {str} {
Lock
set filename "[DataDir]/logfile"
set fid [open $filename "a"]
catch {chmod 0666 $filename}
puts $fid "[fmtclock [getclock] "%D %H:%M"] $str"
close $fid
Unlock
}
proc GenerateProfileHTML {name} {
global ldapserver ldapport
foreach i {
{cn Name}
{mail E-mail}
{telephonenumber Phone}
{pager Pager}
{nscpcurcontactinfo {Contact Info}}
} {
lassign $i n t
lappend namelist $n
set title($n) $t
set value($n) ""
}
if {[catch {set fid [open "|./data/ldapsearch -b \"o=Netscape Communications Corp.,c=US\" -h $ldapserver -p $ldapport -s sub \"(mail=$name@netscape.com)\" $namelist" r]} errinfo]} {
return "<B>Error -- Couldn't contact the directory server.</B><PRE>$errinfo</PRE>"
}
set result "<TABLE>"
while {[gets $fid line] >= 0} {
if {[regexp -- {^([a-z]*): (.*)$} $line foo n v]} {
lappend value($n) $v
}
}
if {[catch {close $fid} errinfo]} {
return "<B>Error -- problem running ldapsearch.</B><PRE>$errinfo</PRE>"
}
foreach i $namelist {
foreach v $value($i) {
append result "<TR><TD align=right><B>$title($i):</B></TD>"
append result "<TD>$v</TD></TR>"
}
}
append result "</TABLE>"
return $result
}
proc MyFmtClock {time} {
return [fmtclock $time "%D %T"]
}
proc LoadMOTD {} {
global motd
Lock
set motd {}
if {[file exists [DataDir]/motd]} {
uplevel #0 source [DataDir]/motd
}
Unlock
}
proc WriteMOTD {} {
global motd
Lock
set fid [open [DataDir]/motd "w"]
catch {chmod 0666 [DataDir]/motd}
puts $fid [list set motd $motd]
close $fid
Unlock
}
proc LoadWhiteboard {} {
global whiteboard origwhiteboard
set whiteboard {}
Lock
if {[file exists [DataDir]/whiteboard]} {
set whiteboard [read_file [DataDir]/whiteboard]
}
Unlock
set origwhiteboard $whiteboard
}
proc WriteWhiteboard {} {
global whiteboard origwhiteboard
if {![cequal $origwhiteboard $whiteboard]} {
Lock
set filename "[DataDir]/whiteboard"
if {[file exists $filename]} {
catch {unlink $filename}
}
set fid [open $filename w]
puts $fid $whiteboard
close $fid
catch {chmod 0666 $filename}
Unlock
}
}
proc LoadTreeConfig {} {
global treelist treeinfo
Lock
set treelist {}
catch {unset treeinfo}
set filename data/configdata
if {[file exists $filename]} {
uplevel #0 source $filename
}
Unlock
}
proc Pluralize {str num} {
if {$num == 1} {
return $str
} else {
return "[set str]s"
}
}
proc MailDiffs {name oldstr newstr} {
if {[cequal $oldstr $newstr]} {
return
}
set old "data/old[set name].[id process]"
set new "data/new[set name].[id process]"
set diffs data/diffs.[id process]
set fid [open $old "w"]
puts $fid $oldstr
close $fid
set fid [open $new "w"]
puts $fid $newstr
close $fid
catch {exec diff -c -b $old $new > $diffs}
set difftext [read_file $diffs]
if {[clength $difftext] > 3} {
set text "From: bonsai-daemon
To: bonsai-messageinterest@glacier, mcom.dev.client.build.busted
Subject: [SubjectTag] Changes made to $name
Mime-Version: 1.0
Content-Type: text/plain
$difftext
"
exec /usr/lib/sendmail -t << $text
}
unlink $old
unlink $new
unlink $diffs
}
proc PrettyDelta {delta} {
set result ""
set oneday [expr 24*60*60]
if {$delta > $oneday} {
set numdays [$delta / $oneday]
append result " $numdays day"
if {$numdays > 1} {
append result "s"
}
set delta [expr $delta % $oneday]
}
set onehour [expr 60*60]
set numhours [expr $delta / $onehour]
if {$numhours > 0} {
append result " $numhours hour"
if {$numhours > 1} {
append result "s"
}
set delta [expr $delta % $onehour]
}
set oneminute 60
set numminutes [expr $delta / $oneminute]
if {$numminutes > 0} {
append result " $numminutes minute"
if {$numminutes > 1} {
append result "s"
}
set delta [expr $delta % $oneminute]
}
if {$delta > 0} {
append result " $delta second"
if {$delta > 1} {
append result "s"
}
}
return $result
}
# Generate a string to put at the head of a subject of an e-mail.
proc SubjectTag {} {
global treeid
if {[cequal $treeid default]} {
return {[Bonsai]}
} else {
return "\[Bonsai-$treeid\]"
}
}
# Confirm that the given password is right. If not, generate HTML and exit.
proc CheckGlobalPassword {password {encoded {}}} {
set fid [open data/passwd "r"]
set correct [string trim [read $fid]]
close $fid
if {[clength $encoded] == 0} {
set encoded [string trim [exec ./data/trapdoor $password]]
}
if {![cequal $correct $encoded]} {
puts "<TITLE>Bzzzzt!</TITLE>"
puts "<H1>Invalid password.</h1>"
puts "Please click the <b>Back</b> button and try again."
Log "Invalid admin password entered."
exit
}
}
proc CheckPassword {password} {
set encoded [string trim [exec ./data/trapdoor $password]]
set f [DataDir]/treepasswd
set correct "xxx $encoded"
if {[file exists $f]} {
set fid [open $f "r"]
set correct [string trim [read $fid]]
close $fid
}
if {![cequal $correct $encoded]} {
CheckGlobalPassword $password $encoded
}
}
proc ParseTimeAndCheck {timestr} {
if {[catch {set result [convertclock $timestr]}]} {
puts "
<TITLE>Time trap</TITLE>
<H1>Can't grok the time</H1>
You entered a time of <tt>$timestr</tt>, and I can't understand it. Please
hit <B>Back</B> and try again."
exit
}
return $result
}
proc MungeTagName {name} {
set result ""
foreach c [split $name ""] {
scan $c "%c" value
if {$value <= 32 || [regexp {[ %/?*]} $c]} {
append result [format "%%%02x" $value]
} else {
append result $c
}
}
return $result
}

32
webtools/bonsai/handleAdminMail.tcl Executable file
Просмотреть файл

@ -0,0 +1,32 @@
#!/usr/bonsaitools/bin/mysqltcl
# -*- Mode: tcl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Bonsai CVS tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
# cd /u/terry/warproot/projects/bonsai
cd /d/webdocs/projects/bonsai
set filename data/admin.[id process]
catch {unlink $filename}
exec cat >> $filename
catch {chmod 0666 $filename}
exec ./adminmail.tcl $filename
# unlink $filename
exit

0
webtools/bonsai/handleCheckinMail.tcl Executable file
Просмотреть файл

61
webtools/bonsai/header.pl Normal file
Просмотреть файл

@ -0,0 +1,61 @@
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Bonsai CVS tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
sub EmitHtmlTitleAndHeader {
my($doctitle,$heading,$subheading) = @_;
print "<HTML><HEAD><TITLE>$doctitle</TITLE></HEAD>";
print "<BODY BGCOLOR=\"#FFFFFF\" TEXT=\"#000000\"";
print "LINK=\"#0000EE\" VLINK=\"#551A8B\" ALINK=\"#FF0000\">";
if (open(BANNER, "<data/banner.html")) {
while (<BANNER>) { print; }
close BANNER;
} elsif (open(BANNER, "<../bonsai/data/banner.html")) {
while (<BANNER>) { print; }
close BANNER;
}
print "<TABLE BORDER=0 CELLPADDING=12 CELLSPACING=0 WIDTH=\"100%\">";
print " <TR>\n";
print " <TD>\n";
print " <TABLE BORDER=0 CELLPADDING=0 CELLSPACING=2>\n";
print " <TR><TD VALIGN=TOP ALIGN=CENTER NOWRAP>\n";
print " <FONT SIZE=\"+3\"><B><NOBR>$heading</NOBR></B></FONT>\n";
print " </TD></TR><TR><TD VALIGN=TOP ALIGN=CENTER>\n";
print " <B>$subheading</B>\n";
print " </TD></TR>\n";
print " </TABLE>\n";
print " </TD>\n";
print " <TD>\n";
if (open(BLURB, "<data/blurb")) {
while (<BLURB>) { print; }
close BLURB;
}
print "</TD></TR></TABLE>\n";
}
sub EmitHtmlHeader {
my($heading,$subheading) = @_;
EmitHtmlTitleAndHeader($heading,$heading,$subheading);
}
1;

12
webtools/bonsai/index.html Normal file
Просмотреть файл

@ -0,0 +1,12 @@
<html>
<head>
<meta http-equiv="Refresh"
content="0; URL=toplevel.cgi">
</head>
<body>
Going to<br>
<br>
<a href="toplevel.cgi">toplevel.cgi</a>
<br>
</body>
</html>

44
webtools/bonsai/indextest.pl Executable file
Просмотреть файл

@ -0,0 +1,44 @@
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Bonsai CVS tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
if( $ARGV[0] eq '' ){
$CVS_ROOT = '/m/src';
}
else {
$CVS_ROOT = $ARGV[0];
}
$CVS_REPOS_SUFIX = $CVS_ROOT;
$CVS_REPOS_SUFIX =~ s/\//_/g;
$CHECKIN_DATA_FILE = "data/checkinlog${CVS_REPOS_SUFIX}";
$CHECKIN_INDEX_FILE = "data/index${CVS_REPOS_SUFIX}";
open(INDEX , "<$CHECKIN_INDEX_FILE");
open(CI, "<$CHECKIN_DATA_FILE") || die "could not open checkin data file\n";
while( <INDEX> ){
chop;
($o,$d) = split(/\|/);
seek(CI, $o, 0);
$line = <CI>;
($j,$d1) = split(/\|/);
print "$d|$d1\n";
}

89
webtools/bonsai/lloydcgi.pl Executable file
Просмотреть файл

@ -0,0 +1,89 @@
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Bonsai CVS tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
%form = ();
&split_cgi_args;
1;
sub split_cgi_args {
local (@args, $pair, $key, $value, $s);
if ($ENV{"REQUEST_METHOD"} eq 'POST') {
$s .= $_ while (<>);
}
else {
$s = $ENV{"QUERY_STRING"};
}
$s =~ tr/+/ /;
@args= split(/\&/, $s );
for $pair (@args) {
($key, $value) = split(/=/, $pair);
$key =~ s/%([a-fA-F0-9]{2})/pack("C", hex($1))/eg;
$value =~ s/%([a-fA-F0-9]{2})/pack("C", hex($1))/eg;
$form{$key} = $value;
}
# extract the cookies from the HTTP_COOKIE environment
%cookie_jar = split('[;=] *',$ENV{'HTTP_COOKIE'});
}
sub make_cgi_args {
local($k,$v,$ret);
for $k (sort keys %form){
$ret .= ($ret eq "" ? '?' : '&');
$v = $form{$k};
$ret .= &url_encode2($k);
$ret .= '=';
$ret .= &url_encode2($v);
}
return $ret;
}
sub url_encode2 {
local( $s ) = @_;
$s =~ s/\%/\%25/g;
$s =~ s/\=/\%3d/g;
$s =~ s/\?/\%3f/g;
$s =~ s/ /\%20/g;
$s =~ s/\n/\%0a/g;
$s =~ s/\r//g;
$s =~ s/\"/\%22/g;
$s =~ s/\'/\%27/g;
$s =~ s/\|/\%7c/g;
$s =~ s/\&/\%26/g;
return $s;
}
@weekdays = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
@months = ('Jan','Feb','Mar','Apr','May','Jun',
'Jul','Aug','Sep','Oct','Nov','Dec');
sub toGMTString {
local ($seconds) = $_[0];
local ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)
= gmtime($seconds);
$year += 1900;
sprintf('%s, %02d-%s-%d %02d:%02d:%02d GMT',
$weekdays[$wday],$mday,$months[$mon],$year,$hour,$min,$sec);
}

0
webtools/bonsai/localprofile.cgi Executable file
Просмотреть файл

146
webtools/bonsai/maketables.sh Executable file
Просмотреть файл

@ -0,0 +1,146 @@
#!/bin/sh
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Bonsai CVS tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
mysql > /dev/null 2>/dev/null << OK_ALL_DONE
use bonsai;
drop table descs;
drop table checkins;
drop table people;
drop table repositories;
drop table dirs;
drop table files;
drop table branches;
drop table tags;
OK_ALL_DONE
mysql << OK_ALL_DONE
use bonsai;
create table descs (
id mediumint not null auto_increment primary key,
description text
);
show columns from descs;
show index from descs;
create table people (
id mediumint not null auto_increment primary key,
who varchar(16) not null,
unique(who)
);
show columns from people;
show index from people;
create table repositories (
id mediumint not null auto_increment primary key,
repository varchar(64) not null,
unique(repository)
);
show columns from repositories;
show index from repositories;
create table dirs (
id mediumint not null auto_increment primary key,
dir varchar(128) not null,
unique(dir)
);
show columns from dirs;
show index from dirs;
create table files (
id mediumint not null auto_increment primary key,
file varchar(128) not null,
unique(file)
);
show columns from files;
show index from files;
create table branches (
id mediumint not null auto_increment primary key,
branch varchar(64) not null,
unique(branch)
);
show columns from branches;
show index from branches;
create table checkins (
type enum('Change', 'Add', 'Remove'),
when datetime not null,
whoid mediumint not null,
repositoryid mediumint not null,
dirid mediumint not null,
fileid mediumint not null,
revision varchar(32) not null,
stickytag varchar(255) not null,
branchid mediumint not null,
addedlines int not null,
removedlines int not null,
descid mediumint,
unique (repositoryid,dirid,fileid,revision),
index(when),
index(whoid),
index(repositoryid),
index(dirid),
index(fileid),
index(branchid)
);
show columns from checkins;
show index from checkins;
create table tags (
repositoryid mediumint not null,
branchid mediumint not null,
dirid mediumint not null,
fileid mediumint not null,
revision varchar(32) not null,
unique(repositoryid,dirid,fileid,branchid,revision),
index(repositoryid),
index(dirid),
index(fileid),
index(branchid)
);
OK_ALL_DONE

134
webtools/bonsai/moduleanalyse.cgi Executable file
Просмотреть файл

@ -0,0 +1,134 @@
#!/usr/bonsaitools/bin/perl --
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Bonsai CVS tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
#
# Unroll a module
#
require 'lloydcgi.pl';
require 'cvsmenu.pl';
$|=1;
$CVS_ROOT = $form{"cvsroot"};
print "Content-type: text/html
<HTML>";
require 'modules.pl';
print "
<HEAD>
<TITLE>CVS Module Analyzer</TITLE>
</HEAD>";
cvsmenu("align=right width=20%");
print "
<H1>CVS Module Analyzer</H1>
<p><b>This tool will show you the directories and files that make up a given
cvs module.</b>
";
print "
<p>
<FORM METHOD=GET ACTION='moduleanalyse.cgi'>
";
#
# module selector
#
print "
<nobr><b>Module:</b>
<SELECT name='module' size=5>
";
if( $form{module} eq 'all' || $form{module} eq '' ){
print "<OPTION SELECTED VALUE='all'>All Files in the Repository\n";
}
else {
print "<OPTION VALUE='all'>All Files in the Repository\n";
print "<OPTION SELECTED VALUE='$form{module}'>$form{module}\n";
}
#
# Print out all the Different Modules
#
for $k (sort( keys( %$modules ) ) ){
print "<OPTION value='$k'>$k\n";
}
print "</SELECT></NOBR>\n";
print "
<br>
<br>
<INPUT TYPE=HIDDEN NAME=cvsroot VALUE='$CVS_ROOT'>
<INPUT TYPE=SUBMIT VALUE='Examine Module'>
</FORM>";
if( $form{module} ne '' ){
$mod = $form{module};
print "<h1>Examining Module '$mod'</h1>\n\n";
$mod_map = &get_module_map( $mod );
for $i (sort keys %$mod_map) {
if( -d "$CVS_ROOT/$i"){
print "<dt><tt>Dir:&nbsp;&nbsp;&nbsp;</tt>";
print "<a href=rview.cgi?dir=$i&cvsroot=$CVS_ROOT>$i</a>";
}
elsif ( -r "$CVS_ROOT/$i,v" ){
print "<dt><font color=blue><tt>File:&nbsp;&nbsp;</tt></font>";
print "<a href=cvsblame.cgi?file=$i&root=$CVS_ROOT>$i</a>";
}
else {
print "<dt><font color=red><tt>Error: </tt></font>";
print "$i : Not a file or a directory.";
}
if( $mod_map->{$i} == $IS_LOCAL ){
print "<font color=blue><tt> LOCAL</tt></font>";
}
print "\n";
}
}
sub sortTest {
if( $_[0] eq $form{sortby} ){
return " SELECTED";
}
else {
return "";
}
}
sub dateTest {
if( $_[0] eq $form{date} ){
return " CHECKED value=$_[0]";
}
else {
return "value=$_[0]";
}
}

152
webtools/bonsai/modules.pl Executable file
Просмотреть файл

@ -0,0 +1,152 @@
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Bonsai CVS tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
require 'utils.pl';
$NOT_LOCAL = 1;
$IS_LOCAL = 2;
$modules = {};
if( $CVS_ROOT eq "" ){
$CVS_ROOT = pickDefaultRepository();
}
if( $ENV{"OS"} eq "Windows_NT" ){
$CVS_MODULES='modules';
}
else {
$CVS_MODULES="${CVS_ROOT}/CVSROOT/modules";
}
open( MOD, "<$CVS_MODULES") || die "can't open $CVS_MODULES";
&parse_modules;
close( MOD );
1;
sub in_module {
local($mod_map, $dirname, $filename ) = @_;
local( @path );
local( $i, $fp, $local );
#
#quick check if it is already in there.
#
if( $mod_map{$dirname} ){
return 1;
}
@path = split(/\//, $dirname);
$fp = '';
for( $i = 0; $i < @path; $i++){
$fp .= ($fp ne '' ? '/' : '') . $path[$i];
if( $local = $mod_map->{$fp} ){
if( $local == $IS_LOCAL ){
if( $i == (@path-1) ){
return 1;
}
}
else {
# Add directories to the map as we encounter them so we go
# faster
if( $mod_map{$dirname} == 0 ){
$mod_map{$dirname} = $IS_LOCAL;
}
return 1;
}
}
}
if( $mod_map->{ $fp . '/' . $filename} ) {
return 1;
}
else {
return 0;
}
}
sub get_module_map {
local($name) = @_;
local($mod_map);
$mod_map = {};
&build_map( $name, $mod_map );
return $mod_map;
}
sub parse_modules {
while( $l = &get_line ){
($mod_name, $flag, @params) = split(/[ \t]+/,$l);
if( $flag ne '-a' ){
next;
}
$modules->{$mod_name} = [@params];
}
}
sub build_map {
local($name,$mod_map) = @_;
local($bFound, $local);
$local = $NOT_LOCAL;
$bFound = 0;
for $i ( @{$modules->{$name}} ){
$bFound = 1;
if( $i eq '-l' ){
$local = $IS_LOCAL;
}
elsif( !build_map($i, $mod_map )){
$mod_map->{$i} = $local;
}
}
return $bFound;
}
sub get_line {
local($l, $save);
$bContinue = 1;
while( $bContinue && ($l = <MOD>) ){
chop($l);
if( $l =~ /^[ \t]*\#/
|| $l =~ /^[ \t]*$/ ){
$l='';
}
elsif( $l =~ /\\[ \t]*$/ ){
chop ($l);
$save .= $l . ' ';
}
elsif( $l eq '' && $save eq ''){
# ignore blank lines
}
else {
$bContinue = 0;
}
}
return $save . $l;
}

129
webtools/bonsai/multidiff.cgi Executable file
Просмотреть файл

@ -0,0 +1,129 @@
#!/usr/bonsaitools/bin/perl --
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Bonsai CVS tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
#
# Multi file diff cgi
#
require 'utils.pl';
$|=1;
print "Content-type: text/html
<PRE><FONT FACE='Lucida Console'>
";
@revs = ();
#if( $ENV{"QUERY_STRING"} eq "" ){
# $ENV{"QUERY_STRING"}="brendan%2Cns%2Fjs%2Fsrc%2Cjsapi.c%2C-1=on&brendan%2Cns%2Fjs%2Fsrc%2Cjsapi.h%2C-1=on&brendan%2Cns%2Fjs%2Fsrc%2Cjsarray.c%2C-106=on&brendan%2Cns%2Fjs%2Fsrc%2Cjsarray.h%2C-0=on&brendan%2Cns%2Fjs%2Fsrc%2Cjsatom.c%2C-9=on";
#}
&split_cgi_args;
#while( ($k,$v) = each(%ENV) ){
# print "$k='$v'\n";
#}
if( $form{"cvsroot"} ne "" ){
$cvsroot = $form{"cvsroot"};
}
else {
$cvsroot = pickDefaultRepository();
}
if( $form{"allchanges"} ne "" ){
@revs = split(/,/, $form{"allchanges"} );
}
else {
while( ($k, $v) = each( %form ) ){
push( @revs, $k );
}
}
$didone = 0;
for $k (@revs) {
($who,$dir,$file,$rev) = split(/\|/, $k );
if ($rev eq "") {
next;
}
$prevrev = &PrevRev($rev);
# this doesn't handle files in the attic
open( DIFF, "/tools/ns/bin/rcsdiff -c -r$prevrev -r$rev $cvsroot/$dir/$file,v 2>&1|" );
$_ =~ s/&/&amp;/g;
$_ =~ s/</&lt;/g;
while(<DIFF>){
print "$who: $_";
}
$didone = 1;
}
if ($didone == 0) {
print "No changes were selected. Please press <b>Back</b> and try again.\n";
}
sub split_cgi_args {
local($i,$var,$value, $s);
if( $ENV{"REQUEST_METHOD"} eq 'POST'){
while(<> ){
$s .= $_;
}
}
else {
$s = $ENV{"QUERY_STRING"};
}
@args= split(/\&/, $s );
for $i (@args) {
($var, $value) = split(/=/, $i);
$var =~ tr/+/ /;
$var =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$form{$var} = $value;
}
}
sub PrevRev {
local( $rev ) = @_;
local( $i, $j, $ret, @r );
@r = split( /\./, $rev );
$i = @r-1;
$r[$i]--;
if( $r[$i] == 0 ){
$i -= 2;
}
$j = 0;
while( $j < $i ){
$ret .= "$r[$j]\.";
$j++
}
$ret .= $r[$i];
}

79
webtools/bonsai/myglobrecur.tcl Normal file
Просмотреть файл

@ -0,0 +1,79 @@
# -*- Mode: tcl; indent-tabs-mode: nil -*-
# The below was taken from the tclX distribution (version 7.4a), and modified
# to quietly continue if it runs into a directory it doesn't have permission
# to enter, and also to skip . directories.
#
# globrecur.tcl --
#
# Build or process a directory list recursively.
#------------------------------------------------------------------------------
# Copyright 1992-1994 Karl Lehenbauer and Mark Diekhans.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that the above copyright notice appear in all copies. Karl Lehenbauer and
# Mark Diekhans make no representations about the suitability of this
# software for any purpose. It is provided "as is" without express or
# implied warranty.
#------------------------------------------------------------------------------
# $Id: myglobrecur.tcl,v 1.1 1998-06-16 21:43:04 terry Exp $
#------------------------------------------------------------------------------
#
proc my_for_recursive_glob {var dirlist globlist cmd {depth 1}} {
upvar $depth $var myVar
set recurse {}
foreach dir $dirlist {
if ![file isdirectory $dir] {
error "\"$dir\" is not a directory"
}
set code 0
set result {}
foreach pattern $globlist {
if {[catch {set list [glob -nocomplain -- $dir/$pattern]}]} {
continue
}
foreach file $list {
set myVar $file
set code [catch {uplevel $depth $cmd} result]
if {$code != 0 && $code != 4} break
}
if {$code != 0 && $code != 4} break
}
if {$code != 0 && $code != 4} {
if {$code == 3} {
return $result
}
if {$code == 1} {
global errorCode errorInfo
return -code $code -errorcode $errorCode \
-errorinfo $errorInfo $result
}
return -code $code $result
}
if {[catch {set list [readdir $dir]}]} {
continue
}
foreach file $list {
set file $dir/$file
if [file isdirectory $file] {
set fileTail [file tail $file]
if {![cequal "." [crange $fileTail 0 0]]} {
lappend recurse $file
}
}
}
}
if ![lempty $recurse] {
return [my_for_recursive_glob $var $recurse $globlist $cmd \
[expr {$depth + 1}]]
}
return {}
}

35
webtools/bonsai/openmessage Normal file
Просмотреть файл

@ -0,0 +1,35 @@
From: bonsai-daemon
To: %name%
Subject: [Bonsai] You're on the hook now!
Mime-Version: 1.0
Content-Type: text/html
<HTML>
<H1>You are responsible to make sure the build works.</H1>
You just checked into <tt>%dir%</tt> the files <tt>%files%</tt>. At
about <tt>%nextclose%</tt>, the tree will be frozen. From about
an hour later on, you are to be available for the build team to pester
in case of any problems.
<P>
Any further checkins you make before the tree closes will <i>not</i>
cause you to receive more copies of this mail, but you'll be held
responsible for them too.
<P>
For more info on the current state of the tree, see the
<a href=http://warp/bonsai/toplevel.cgi>Bonsai main page</a>.
<P>
Your contact info and other vital data is listed below. Please
<a href=http://warp/bonsai/profile.cgi?person=%name%>update</a>
this info <b>immediately</b> if it is at all inaccurate or incorrect.
<hr>
%profile%

83
webtools/bonsai/perlifyconfig.tcl Executable file
Просмотреть файл

@ -0,0 +1,83 @@
#!/usr/bonsaitools/bin/mysqltcl
# -*- Mode: tcl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Bonsai CVS tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
# Oy, what a hack.
#
# Bonsai has a split heritage, and so some of it is written in Perl, and
# some of it is written in TCL. The perl half wants to be able to look
# at the basic configuration, kept in data/configdata. But that file is
# designed to be quickly read by TCL. And I don't feel like writing perl
# code to parse it. So, instead, we have this hack which will read the
# file and push it out in a form friendlier to perl. Gross, gross, gross.
source globals.tcl
proc haschar {str char} {
return [string match "*$char*" $str]
}
proc PerlStringify {str} {
if {![haschar $str "'"]} {
return "'$str'"
}
foreach i [list "/" ":" "@" "#" "%" "^"] {
if {![haschar $str $i]} {
return "q$i$str$i"
}
}
}
Lock
LoadTreeConfig
set outfilename "data/configdata.pl"
set fid [open $outfilename "w"]
puts $fid "\# WARNING! Do not edit this file! Automatically generated!"
puts $fid "\# You want to instead edit the 'configdata' file. This file"
puts $fid "\# gets automatically generated from that one."
puts $fid ""
regsub -all {(^|[^\])&} $BUGSYSTEMEXPR {\1$\&} BUGSYSTEMEXPR
puts $fid "\$BUGSYSTEMEXPR = [PerlStringify $BUGSYSTEMEXPR];"
set list ""
foreach i $treelist {
append list [PerlStringify $i]
append list ", "
}
puts $fid "@treelist = ($list);"
foreach i [lsort [array names treeinfo]] {
lassign [split $i ","] a b
if {![info exists done($a)]} {
set done($a) 1
puts $fid "\$treeinfo{[PerlStringify $a]} = {};"
}
puts $fid "\$treeinfo{[PerlStringify $a]}->{[PerlStringify $b]} = [PerlStringify $treeinfo($i)];"
}
close $fid
catch {chmod 0666 $outfilename}
Unlock

35
webtools/bonsai/processqueue.pl Executable file
Просмотреть файл

@ -0,0 +1,35 @@
#!/usr/bonsaitools/bin/perl --
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Bonsai CVS tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
# This takes a bunch of files that have been put into the 'bonsai
# queue' (the 'queue' subdirectory) and processes them as checkins.
# This is to work around worlds where we can't send mail from inside
# the CVS loginfo file.
#
# Each file is expected to have the CVSROOT in the first line, any args in the
# second line (currently unused), and the data fed to loginfo as the remaining
# lines.
$inprocess = "data/queue/processing-$$";
foreach $file (sort(glob("data/queue/*.q"))) {
rename $file, $inprocess || die "Couldn't rename queue file.";
system "./dolog.pl < $inprocess";
rename $inprocess, "$file.done";
}

83
webtools/bonsai/profile.cgi Executable file
Просмотреть файл

@ -0,0 +1,83 @@
#!/usr/bonsaitools/bin/mysqltcl
# -*- Mode: tcl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Bonsai CVS tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
source CGI.tcl
if {![info exists FORM(person)]} {
puts {
<TITLE>Uh, who?</TITLE>
<H1>Who would you like to know more about?</H1>
Please enter the username of the person whose Bonsai profile
you'd like to see.
<p>
<form method=get action="profile.cgi">
<B>User:</B><INPUT SIZE=10 NAME=person>
<INPUT TYPE=SUBMIT Value="Submit"></FORM>
}
PutsTrailer
exit
}
set fid [open "|./data/ldapsearch -b \"o=Netscape Communications Corp.,c=US\" -h $ldapserver -p $ldapport -s sub \"(mail=$FORM(person)@netscape.com)\" cn" r]
while {[gets $fid line] >= 0} {
if {[regexp -- {^cn: (.*)$} $line foo n]} {
set fullname $n
}
}
close $fid
if {![info exists fullname]} {
puts {
<TITLE>Uh, who?</TITLE>
<H1>Who would you like to know more about?</H1>
There doesn't seem to be anybody with e-mail address
<b><tt>$FORM(person)</tt></b>.
<p>
Please enter the username of the person whose Bonsai profile
you'd like to see.
<p>
<form method=get action="profile.cgi">
<B>User:</B><INPUT SIZE=10 NAME=person>
<INPUT TYPE=SUBMIT Value="Submit"></FORM>
}
PutsTrailer
exit
}
puts "Content-type: text/html
Refresh: 0; URL=http://phonebook/cgi-bin/expand-entry.pl?fullname=[url_quote "$fullname,o=Netscape Communications Corp.,c=US"]
<HTML>
<TITLE>What a hack.</TITLE>
One moment while we whisk you away to the appropriate phonebook page..."
exit

386
webtools/bonsai/rebuildcvshistory.cgi Executable file
Просмотреть файл

@ -0,0 +1,386 @@
#!/usr/bonsaitools/bin/mysqltcl
# -*- Mode: tcl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Bonsai CVS tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
source CGI.tcl
source myglobrecur.tcl
if {[llength $argv] == 5} {
lassign $argv treeid FORM(startfrom) FORM(firstfile) FORM(subdir) FORM(modules)
} else {
puts "Content-type: text/plain
<HTML>"
CheckPassword $FORM(password)
}
set startfrom [ParseTimeAndCheck [FormData startfrom]]
set firstfile [string trim [FormData firstfile]]
set subdir [string trim [FormData subdir]]
Lock
LoadTreeConfig
Unlock
ConnectToDatabase
set repository $treeinfo($treeid,repository)
regsub -all -- / $repository _ mungedname
puts "Rebuilding entire checkin history in $treeinfo($treeid,description) ..."
flush stdout
# cmdtrace on
set repositoryid [GetId repositories repository $repository]
proc ProcessOneFile {filename} {
global repository startfrom
puts "$filename"
flush stdout
set fid [open "|/tools/ns/bin/rlog $filename" r]
set doingtags 0
catch {unset branchname}
regsub -- {,v$} $filename {} filerealname
set filehead [file dirname $filerealname]
regsub -- "^$repository" $filehead {} filehead
regsub -- {^/} $filehead {} filehead
if {[clength $filehead] == 0} {
set filehead "."
}
set filetail [file tail $filerealname]
while {1} {
if {[gets $fid line] < 0} {
break
}
set trimmed [string trim $line]
if {$doingtags} {
if {![cequal "\t" [crange $line 0 0]]} {
set doingtags 0
} else {
lassign [split $trimmed ":"] tag version
if {[clength $tag] == 0 || [clength $version] == 0} {
continue
}
set version [string trim $version]
set branchid [GetId branches branch $tag]
set dirid [GetId dirs dir $filehead]
set fileid [GetId files file $filetail]
# Don't touch the tags database for now. Nothing uses it, and it just takes
# up too much damn space.
# SendSQL "replace into tags (branchid, repositoryid, dirid, fileid, revision) values ($branchid, $repositoryid, $dirid, $fileid, '$version')"
set vlist [split $version '.']
set sub [expr [llength $vlist] - 2]
if {[cequal "0" [lindex $vlist $sub]]} {
# Aha! Second-to-last being a zero is CVS's special way
# of remembering a branch tag.
set bnum [join [lreplace $vlist $sub $sub] "."]
set branchname($bnum) $tag
}
continue
}
}
switch -regexp -- $line {
{^symbolic names} {
set doingtags 1
}
{^revision ([0-9.]*)$} {
set indesc 0
while {1} {
if {$indesc} {
if {[cequal $line "----------------------------"] ||
[cequal $line "============================================================================="]} {
# OK, we're done. Write it out.
if {[info exists revision] &&
[info exists datestr] &&
[info exists author]} {
if {[regexp -- {^([0-9]*)/([0-9]*)/([0-9]*) ([0-9]*):([0-9]*):([0-9]*)$} $datestr foo year month day hours mins secs]} {
set date [convertclock "$month/$day/$year $hours:$mins:$secs" GMT]
if {$date >= $startfrom} {
set tbranch "T$branch"
if {[cequal $tbranch "T"]} {
set tbranch ""
}
set entrystr "C|$date|$author|$repository|$filehead|$filetail|$revision||$branch|+$pluscount|-$minuscount"
AddToDatabase $entrystr $desc
}
}
}
set indesc 0
} else {
append desc $line
append desc "\n"
}
} else {
switch -regexp -- $line {
{^revision ([0-9.]*)$} {
if {[regexp -- {^revision ([0-9.]*)$} $line foo new]} {
set revision $new
catch {unset datestr}
catch {unset author}
set pluscount 0
set minuscount 0
set desc {}
regsub -- {.[0-9]*$} $revision {} bnum
if {[info exists branchname($bnum)]} {
set branch "$branchname($bnum)"
} else {
set branch ""
}
}
}
{^date:} {
regexp -- {^date: ([0-9 /:]*); author: ([^;]*);} $line foo datestr author
regexp -- {lines: \+([0-9]*) -([0-9]*)} $line foo pluscount minuscount
}
{^branches: [0-9 .;]*$} {
# Ignore these lines; make sure they don't
# become part of the desciption.
}
default {
set indesc 1
set desc "$line\n"
}
}
}
if {[gets $fid line] < 0} {
break
}
}
}
}
}
catch {close $fid}
}
proc ProcessDirectory {dir} {
global firstfile
my_for_recursive_glob filename $dir "*,v" {
if {![cequal $firstfile ""]} {
if {![cequal $filename $firstfile]} {
puts "Skipping $filename"
flush stdout
continue
}
set firstfile ""
}
ProcessOneFile $filename
}
}
proc digest {str} {
global array
set key [lvarpop str]
if {[cequal [cindex [lindex $str 0] 0] "-"]} {
lvarpop str
}
set array($key) $str
}
set env(CVSROOT) $treeinfo($treeid,repository)
set origdir [pwd]
cd /
set fid [open "|/tools/ns/bin/cvs checkout -c" r]
cd $origdir
set curline ""
while {[gets $fid line] >= 0} {
if {[ctype space [cindex $line 0]]} {
append curline $line
} else {
digest $curline
set curline $line
}
}
digest $curline
close $fid
set startingdir $repository/$subdir
regsub -- {/\.$} $startingdir {} startingdir
regsub -- {/$} $startingdir {} startingdir
set oldlist {}
set list {}
if {[info exists FORM(modules)]} {
set list [split $FORM(modules) ","]
}
if {[lempty $list]} {
set list $treeinfo($treeid,module)
}
while {![cequal $list $oldlist]} {
set oldlist $list
set list {}
foreach i $oldlist {
if {[info exists array($i)]} {
set list [concat $list $array($i)]
# Do an unset to prevent infinite recursion.
unset array($i)
} else {
lappend list $i
}
}
}
set tlist {}
catch {unset present}
foreach i $list {
if {![info exists present($i)]} {
lappend tlist $i
set present($i) 1
}
}
catch {unset present}
set list {}
foreach i $tlist {
set d $repository/$i
regsub -- {/\.$} $d {} d
regsub -- {/$} $d {} d
lappend list $d
}
if {[lempty $list]} {
set $list $startingdir
}
set slen [expr [clength $startingdir] - 1]
puts "Doing directories: $list"
foreach dir $list {
if {![cequal [crange $dir 0 $slen] $startingdir]} {
puts "*** Skipping $dir ***"
continue
}
if {![file isdirectory $dir]} {
if {[file isfile $dir]} {
ProcessOneFile $dir
}
} else {
ProcessDirectory $dir
}
}
# puts "<HR>Putting entries ($count unique descriptions) into database...<P>"
# flush stdout
# set infid [open data/checkinlog$mungedname "r"]
# ConnectToDatabase
# set buffer {}
# set desc {}
# set indesc 0
# set done 0
# while {[gets $infid line] >= 0} {
# if {$indesc} {
# if {[cequal $line ":ENDLOGCOMMENT"]} {
# AddToDatabase $buffer $desc
# set buffer {}
# set desc {}
# set indesc 0
# incr done
# if {$done % 5 == 0} {
# puts "$done done.<BR>"
# flush stdout
# }
# } else {
# append desc $line
# append desc "\n"
# }
# } else {
# if {[cequal $line "LOGCOMMENT"]} {
# set indesc 1
# } else {
# append buffer $line
# append buffer "\n"
# }
# }
# }
# close $infid
# puts "<HR>"
# flush stdout
# set dir data/taginfo
# catch {mkdir $dir}
# catch {chmod 0777 $dir}
# append dir /tmp_[set mungedname]_[id process]
# catch {mkdir $dir}
# catch {chmod 0777 $dir}
# set numtags 0
# foreach n [lsort [info var tag_*]] {
# upvar #0 $n t
# set tagname [crange $n 4 end]
# puts "Dumping tag $tagname<br>"
# flush stdout
# set filename $dir/[MungeTagName $tagname]
# set fid [open "$filename" "w"]
# foreach f [lsort [array names t]] {
# puts $fid "0|add|$f|$t($f)"
# }
# close $fid
# incr numtags
# }
# Lock
# set newdir data/taginfo/$mungedname
# catch {exec rm -rf $newdir}
# frename $dir $newdir
# Unlock
# puts "<HR><P>Done. $numfiles files checked; $numtags tags created.<P>"

0
webtools/bonsai/rebuilddatabase.tcl Executable file
Просмотреть файл

103
webtools/bonsai/rebuildtaginfo.cgi Executable file
Просмотреть файл

@ -0,0 +1,103 @@
#!/usr/bonsaitools/bin/mysqltcl
# -*- Mode: tcl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Bonsai CVS tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
source CGI.tcl
source myglobrecur.tcl
puts "Content-type: text/html
<HTML>"
CheckPassword $FORM(password)
Lock
LoadTreeConfig
Unlock
set repository $treeinfo($treeid,repository)
regsub -all -- / $repository _ mungedname
puts "<H1>Searching for tags in all files in $repository ...</h1>"
flush stdout
set numfiles 0
set numtags 0
my_for_recursive_glob filename $repository "*,v" {
puts "$filename<br>"
flush stdout
set fid [open "|/tools/ns/bin/rlog -h $filename" r]
set doingtags 0
while {1} {
if {[gets $fid line] < 0} {
break
}
if {$doingtags} {
if {![cequal "\t" [crange $line 0 0]]} {
break
}
lassign [split [string trim $line] ":"] tag version
if {[clength $tag] == 0 || [clength $version] == 0} {
continue
}
set tag_[set tag]($cutename) [string trim $version]
} elseif {[cequal [string trim $line] "symbolic names:"]} {
set doingtags 1
regsub -- {,v$} $filename {} tmp
regsub -- {/([^/]*$)} $tmp {|\1} cutename
}
}
catch {close $fid}
incr numfiles
}
puts "<HR>"
flush stdout
set dir data/taginfo
catch {mkdir $dir}
catch {chmod 0777 $dir}
append dir /tmp_[set mungedname]_[id process]
catch {mkdir $dir}
catch {chmod 0777 $dir}
foreach n [lsort [info var tag_*]] {
upvar #0 $n t
set tagname [crange $n 4 end]
puts "Dumping tag $tagname<br>"
flush stdout
set filename $dir/[MungeTagName $tagname]
set fid [open "$filename" "w"]
foreach f [lsort [array names t]] {
puts $fid "0|add|$f|$t($f)"
}
close $fid
incr numtags
}
Lock
set newdir data/taginfo/$mungedname
catch {exec rm -rf $newdir}
frename $dir $newdir
Unlock
puts "<HR><P>Done. $numfiles files checked; $numtags tags created.<P>"
PutsTrailer

134
webtools/bonsai/repophook.cgi Executable file
Просмотреть файл

@ -0,0 +1,134 @@
#!/usr/bonsaitools/bin/mysqltcl
# -*- Mode: tcl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Bonsai CVS tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
source CGI.tcl
puts "Content-type: text/html
<HTML>"
CheckPassword $FORM(password)
set startfrom [ParseTimeAndCheck [FormData startfrom]]
Lock
LoadTreeConfig
LoadCheckins
set checkinlist {}
WriteCheckins
Unlock
puts "<TITLE> Rebooting, please wait...</TITLE>
<H1>Recreating the hook</H1>
<h3>$treeinfo($treeid,description)</h3>
<p>
Searching for first checkin after [MyFmtClock $startfrom]...<p>"
flush stdout
regsub -all -- / $treeinfo($treeid,repository) _ mungedname
set filename "data/checkinlog$mungedname"
set fid [open $filename "r"]
set foundfirst 0
set buffer {}
set tempfile data/repophook.[id process]
proc FlushBuffer {} {
global buffer tempfile treeid foundfirst count
if {!$foundfirst || [cequal $buffer ""]} {
return
}
write_file $tempfile "junkline\n\n$buffer"
exec ./addcheckin.tcl -treeid $treeid $tempfile
unlink $tempfile
set buffer {}
incr count
if {$count % 100 == 0} {
puts "$count scrutinized...<br>"
flush stdout
}
}
set now [getclock]
set count 0
set lastdate 0
while {[gets $fid line] >= 0} {
switch -glob -- $line {
{?|*} {
lassign [split $line "|"] chtype date
if {$date < $lastdate} {
puts "Ick; dates out of order!<br>"
puts "<pre>[value_quote $line]</pre><p>"
}
set $lastdate $date
if {$foundfirst} {
append buffer "$line\n"
} else {
if {$date >= $startfrom} {
if {$date >= $now} {
puts "Found a future date! (ignoring):<br>"
puts "<pre>[value_quote $line]</pre><p>"
flush stdout
} else {
set foundfirst 1
puts "Found first line: <br><pre>[value_quote $line]</pre><p>"
puts "OK, now processing checkins...<p>"
flush stdout
set buffer "$line\n"
set count 0
}
} else {
incr count
if {$count % 2000 == 0} {
puts "Skipped $count lines...<p>"
flush stdout
}
}
}
}
{:ENDLOGCOMMENT} {
append buffer "$line\n"
FlushBuffer
}
default {
append buffer "$line\n"
}
}
}
FlushBuffer
catch {unset checkinlist}
LoadCheckins
puts "Done. [llength $checkinlist] relevant checkins were found."
PutsTrailer

58
webtools/bonsai/reposfiles.pl Executable file
Просмотреть файл

@ -0,0 +1,58 @@
#!/usr/bonsaitools/bin/perl --
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Bonsai CVS tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
if( $ARGV[0] eq '' ){
$CVS_ROOT = '/m/src';
}
else {
$CVS_ROOT = $ARGV[0];
}
$CVS_REPOS_SUFIX = $CVS_ROOT;
$CVS_REPOS_SUFIX =~ s/\//_/g;
$FILE_LIST = "/d/webdocs/projects/bonsai/data/reposfiles${CVS_REPOS_SUFIX}";
open FL, ">$FILE_LIST";
GoDir($CVS_ROOT);
sub GoDir {
local($dir) = @_;
local(@dirs, $i);
chdir "$dir";
while(<*> ){
if( $_ ne '.' && $_ ne '..' ){
if( -d $_ ) {
push @dirs, $_;
}
else {
print FL "$dir/$_\n";
}
}
}
for $i (@dirs) {
GoDir( "$dir/$i");
}
}

196
webtools/bonsai/rview.cgi Executable file
Просмотреть файл

@ -0,0 +1,196 @@
#!/usr/bonsaitools/bin/perl --
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Bonsai CVS tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
#
# Query the CVS database.
#
require 'lloydcgi.pl';
require 'cvsmenu.pl';
$|=1;
$CVS_ROOT = $form{"cvsroot"};
# get dir, remove leading and trailing slashes
$dir = $form{"dir"};
$dir =~ s/^\/([^:]*)/$1/;
$dir =~ s/([^:]*)\/$/$1/;
$rev = $form{"rev"};
print "Content-type: text/html
<HTML>";
&setup_script;
print $script_str;
if( $CVS_ROOT eq "" ){
$CVS_ROOT = pickDefaultRepository();
}
validateRepository($CVS_ROOT);
if( $rev ne "" ){
$s = "for branch <i>$rev</i>";
}
print "
<head><title>Repository Directory $CVS_ROOT/$dir $s</title></head>";
$output = "<DIV ALIGN=LEFT>";
($dir_head, $dir_tail) = $dir =~ m@(.*/)?(.+)@;
foreach $path (split('/',$dir_head)) {
$link_path .= $path;
$output .= "<A HREF='rview.cgi?dir=$link_path";
$output .= "&cvsroot=$form{'cvsroot'}" if defined $form{'cvsroot'};
$output .= "&rev=$rev" unless $rev eq '';
$output .= "'>$path</A>/ ";
$link_path .= '/';
}
chop ($output);
$output .= " $s";
$output .= "</DIV>";
EmitHtmlHeader("Repository Directory", $output);
cvsmenu("align=right width=20%");
chdir "$CVS_ROOT/$dir";
print "
<TABLE CELLPADDING=0 CELLSPACING=0>
<FORM action=rview.cgi method=get><TR><TD>
Goto Directory:
</TD><TD><INPUT name=dir value='$dir' size=30>
<INPUT name=rev value='$rev' type=hidden>
<INPUT name=cvsroot value='$CVS_ROOT' type=hidden>
<INPUT type=submit value='chdir'>
</TD></TR></FORM>
<FORM action=rview.cgi method=get><TR><TD>
Branch:
</TD><TD><INPUT name=rev value='$rev' size=30>
<INPUT name=dir value='$dir' type=hidden>
<INPUT name=cvsroot value='$CVS_ROOT' type=hidden>
<INPUT type=submit value='Set Branch'>
</TR>
</TABLE>
";
@dirs = ();
while( <*> ){
if( -d $_ ){
push @dirs, $_;
}
}
if( @dirs != 0 ){
$j = 1;
$split = int(@dirs/4)+1;
print "<P><FONT SIZE=+1><B>Directories:</B></FONT><table><TR VALIGN=TOP><td>";
for $i (@dirs){
$form{"dir"} = ($dir ne "" ? "$dir/$i" : $i);
$anchor = &make_cgi_args;
print "<dt><a href=rview.cgi${anchor}>$i</a>\n";
if( $j % $split == 0 ){
print "\n<td>\n";
}
$j++;
}
$form{"dir"} = $dir;
print "\n</tr></table>\n";
}
print "<P><FONT SIZE=+1><B>Files:</B></FONT>";
print "<table><TR VALIGN=TOP><td>";
@files = <*,v>;
$j = 1;
$split = int(@files/4)+1;
for $_ (@files){
$_ =~ s/\,v//;
print "<a href=../registry/file.cgi?cvsroot=$CVS_ROOT&file=$_&dir=$dir"
. " onclick=\"return js_file_menu('$dir','$_','$rev','$CVS_ROOT',event)\">\n";
print "<dt>$_</a>\n";
if( $j % $split == 0 ){
print "\n<td>\n";
}
$j++;
}
print "\n</tr></table>\n";
sub setup_script {
$script_str =<<'ENDJS';
<script>
var event = new Object;
function js_who_menu(n,extra,d) {
if( parseInt(navigator.appVersion) < 4 ){
return true;
}
l = document.layers['popup'];
l.src="../registry/who.cgi?email="+n+extra;
l.top = d.target.y - 6;
l.left = d.target.x - 6;
if( l.left + l.clipWidth > window.width ){
l.left = window.width - l.clipWidth;
}
l.visibility="show";
return false;
}
function js_file_menu(dir,file,rev,root,d) {
if( parseInt(navigator.appVersion) < 4 ){
return true;
}
l = document.layers['popup'];
l.src="../registry/file.cgi?file="+file+"&dir="+dir+"&rev="+rev+"&cvsroot="+root+"&linked_text="+d.target.text;
l.top = d.target.y - 6;
l.left = d.target.x - 6;
if( l.left + l.clipWidth > window.width ){
l.left = window.width - l.clipWidth;
}
l.visibility="show";
return false;
}
</script>
<layer name="popup" onMouseOut="this.visibility='hide';" left=0 top=0 bgcolor="#ffffff" visibility="hide">
</layer>
ENDJS
}

0
webtools/bonsai/show2.cgi Executable file
Просмотреть файл

350
webtools/bonsai/showcheckins.cgi Executable file
Просмотреть файл

@ -0,0 +1,350 @@
#!/usr/bonsaitools/bin/mysqltcl
# -*- Mode: tcl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Bonsai CVS tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
source CGI.tcl
Lock
LoadCheckins
LoadTreeConfig
Unlock
# Stupid hack to make an empty array:
set peoplearray(zzz) 1
unset peoplearray(zzz)
set versioninfo ""
proc BreakBig {str} {
set result {}
while {[clength $str] > 20} {
set head [crange $str 0 19]
set w [string last "/" $head]
if {$w < 0} {
set w 19
}
append result "[crange $str 0 $w]<br>"
incr w
set str [crange $str $w end]
}
append result $str
}
set tweak [info exists FORM(tweak)]
set delta_size 1 ;#[info exists FORM(delta_size)]
puts "Content-type: text/html"
if {[info exists FORM(sort)]} {
puts "Set-Cookie: SORT=$FORM(sort)"
} elseif {[info exists COOKIE(SORT)]} {
set FORM(sort) $COOKIE(SORT)
} else {
set FORM(sort) date
}
puts "
<HTML>"
if {[info exists FORM(person)]} {
puts "<TITLE>Checkins for $FORM(person)</TITLE>"
puts "<H1>Checkins for $FORM(person)</H1>"
set list {}
foreach i $checkinlist {
upvar #0 $i info
if {[cequal $info(person) $FORM(person)]} {
lappend list $i
}
}
} elseif {[info exists FORM(mindate)] || [info exists FORM(maxdate)]} {
set str "Checkins"
set min 0
set max [expr 1<<30]
if {[info exists FORM(mindate)]} {
set min $FORM(mindate)
append str " since [fmtclock $min "%m/%d %H:%M"]"
if {[info exists FORM(maxdate)]} {
append str " and"
}
}
if {[info exists FORM(maxdate)]} {
set max $FORM(maxdate)
append str " before [fmtclock $max "%m/%d %H:%M"]"
}
puts "<TITLE>$str</TITLE>"
puts "<H1>$str</H1>"
set list {}
foreach i $checkinlist {
upvar #0 $i info
if {$info(date) >= $min && $info(date) <= $max} {
lappend list $i
}
}
} else {
puts "<TITLE>All checkins</TITLE>"
puts "<H1>All Checkins</H1>"
set list $checkinlist
}
if {$readonly} {
puts "<h2><font color=red>Be aware that you are looking at an old hook!</font></h2>"
}
puts "(Current sort is by <tt>$FORM(sort)</tt>; click on a column header
to sort by that column.)"
# Oh, boy, is this ever gross. Dynamically write some code to be the sort
# comparison routine, so that we know that the sort code will run fast.
set fields [split $FORM(sort) ","]
set w [lsearch $fields "date"]
if {$w >= 0} {
set fields [lrange $fields 0 [expr $w - 1]]
}
set body {
upvar #0 $n1 a $n2 b
}
foreach i $fields {
append body "set delta \[string compare \$a($i) \$b($i)\]"
append body "\n"
append body {if {$delta != 0} {return $delta}}
append body "\n"
}
append body {return [expr $b(date) - $a(date)]}
eval [list proc Compare {n1 n2} $body]
set total_added 0
set total_removed 0
#
# Calculate delta information
#
if {$delta_size} {
foreach i $list {
upvar #0 $i info
set info(added) 0
set info(removed) 0
#
# Loop through the checkins, grab the filename and stickyflags
#
if {[info exists info(fullinfo)]} {
foreach fu $info(fullinfo) {
set fn [lindex $fu 0]
set sticky [lindex $fu 4]
#
# if the file is binary, don't show the delta information
#
if { ![string match {*.gif} $fn]
&& ![string match {*.bmp} $fn]
&& ![string match {-kb} $sticky]} {
scan [lindex $fu 2] {%d} file_added
scan [lindex $fu 3] {%d} file_removed
if {[info exists file_added] && [info exists file_removed]} {
incr info(added) $file_added
incr info(removed) $file_removed
}
}
}
}
set info(lines_changed) [format "%7d" [expr 1000000 - ($info(added) - $info(removed))]]
incr total_added $info(added)
incr total_removed $info(removed)
}
}
set list [lsort -command Compare $list]
regsub -all {[&?]sort=[^&]*} $buffer {} otherparams
proc NewSort {key} {
global otherparams FORM
set list [split $FORM(sort) ","]
set w [lsearch $list $key]
if {$w >= 0} {
set list [lreplace $list $w $w]
}
set list [linsert $list 0 $key]
return "[set otherparams]&sort=[join $list ,]"
}
if {$tweak} {
puts "<FORM method=get action=\"dotweak.cgi\">"
}
puts "
<TABLE border cellspacing=2>
<TR ALIGN=LEFT>
"
if {$tweak} {
puts "<TH></TH>"
}
puts "
<TH><A HREF=\"showcheckins.cgi?[set otherparams]&sort=date\">When</A>
<TH><A HREF=\"showcheckins.cgi?[NewSort treeopen]\">Tree state</A>
<TH><A HREF=\"showcheckins.cgi?[NewSort person]\">Who</A>
<TH><A HREF=\"showcheckins.cgi?[NewSort dir]\">Directory</A>
<TH><A HREF=\"showcheckins.cgi?[NewSort files]\">Files</A>"
if {$delta_size} {
puts "<TH><A HREF=\"showcheckins.cgi?[NewSort lines_changed]\"><tt>+/-</tt></A>"
}
puts "
<TH WIDTH=100%>Description
</TR>"
set count 0
set maxcount 100
set branchpart {}
if {![cequal $treeinfo($treeid,branch) {}]} {
set branchpart "&branch=$treeinfo($treeid,branch)"
}
foreach i $list {
upvar #0 $i info
incr count
if {$count >= $maxcount} {
set count 0
# Don't make tables too big, or toy computers will break.
puts "</TABLE><TABLE border cellspacing=2>"
}
puts "<TR>"
if {$tweak} {
puts "<TD><INPUT TYPE=CHECKBOX NAME=$i></TD>"
}
puts "<TD><a href=editcheckin.cgi?id=$i[BatchIdPart]>"
puts "[fmtclock $info(date) "<font size=-2>%m/%d %H:%M</font>"]</a></TD>"
puts "<TD>"
if {$info(treeopen)} {
puts "open"
} else {
puts "CLOSED"
}
if {[info exists info(notes)]} {
if {![cequal $info(notes) ""]} {
puts "<br>$info(notes)"
}
}
puts "</TD>"
set peoplearray($info(person)) 1
puts "<TD><a href=\"http://phonebook/ds/dosearch/phonebook/uid=[url_quote "$info(person),ou=People,o= Netscape Communications Corp.,c=US"]\">$info(person)</a></TD>"
puts "<TD><a href=\"cvsview2.cgi?root=$treeinfo($treeid,repository)&subdir=$info(dir)&files=[join $info(files) +]&command=DIRECTORY$branchpart\">[BreakBig $info(dir)]</a></TD>"
puts "<TD>"
foreach f $info(files) {
puts "<a href=\"cvsview2.cgi?root=$treeinfo($treeid,repository)&subdir=$info(dir)&files=$f&command=DIRECTORY$branchpart\">$f</a>"
}
puts "</TD>"
if {$delta_size} {
puts "<TD>"
if {$info(removed) < 0} {
set str_removed $info(removed)
} else {
set str_removed "-0"
}
puts "<tt>+$info(added)<br>$str_removed"
puts "</TD>"
}
if {[info exists info(fullinfo)]} {
foreach f $info(fullinfo) {
lassign $f file version
append versioninfo "$info(person)|$info(dir)|$file|$version,"
}
}
puts "<TD WIDTH=100%>$info(log)</TD>"
puts "</TR>"
}
puts "</TABLE>"
if {$delta_size} {
set deltastr " &nbsp;&nbsp;&nbsp; Lines changed <tt>($total_added/$total_removed)</tt>."
} else {
set deltastr ""
}
puts "[llength $list] checkins listed. $deltastr"
if {$tweak} {
puts "
<hr>
Check the checkins you wish to affect. Then select one of the below options.
And type the magic word. Then click on submit.
<P>
<INPUT TYPE=HIDDEN NAME=treeid VALUE=$treeid>
<INPUT TYPE=radio NAME=command VALUE=nuke>Delete these checkins.<BR>
<INPUT TYPE=radio NAME=command VALUE=setopen>Set the tree state on these checkins to be <B>Open</B>.<BR>
<INPUT TYPE=radio NAME=command VALUE=setclose>Set the tree state on these checkins to be <B>Closed</B>.<BR>
<INPUT TYPE=radio NAME=command VALUE=movetree>Move these checkins over to this tree:
<SELECT NAME=desttree SIZE=1>"
proc IsSelected {value} {
global treeid
if {[cequal $value $treeid]} {
return "SELECTED"
} else {
return ""
}
}
foreach i $treelist {
if {![info exists treeinfo($i,nobonsai)]} {
puts "<OPTION [IsSelected $i] VALUE=$i>$treeinfo($i,description)"
}
}
puts "</SELECT><P>
<B>Password:</B><INPUT NAME=password TYPE=password></td>
<BR>
<INPUT TYPE=SUBMIT VALUE=Submit>
</FORM>"
} else {
puts "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;"
puts "<a href=showcheckins.cgi?$buffer&tweak=1>Tweak some of these checkins.</a>"
puts "<br><br>"
puts "<FORM action='multidiff.cgi' method=post>"
puts "<INPUT TYPE='HIDDEN' name='allchanges' value = '$versioninfo'>"
puts "<INPUT TYPE=SUBMIT VALUE='Show me ALL the Diffs'>"
puts "</FORM>"
}
if {[info exists FORM(ltabbhack)]} {
puts "<!-- StupidLloydHack [join [lsort [array names peoplearray]] {,}] -->"
puts "<!-- LloydHack2 $versioninfo -->"
}
PutsTrailer

54
webtools/bonsai/switchtree.cgi Executable file
Просмотреть файл

@ -0,0 +1,54 @@
#!/usr/bonsaitools/bin/mysqltcl
# -*- Mode: tcl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Bonsai CVS tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
source CGI.tcl
LoadTreeConfig
proc IsChecked {value} {
global treeid
if {[cequal $value $treeid]} {
return "CHECKED"
} else {
return ""
}
}
puts "Content-type: text/html
<HTML>
<TITLE>George, George, George of the jungle...</TITLE>
Which tree would you like to see?
"
puts "<FORM method=get action=\"toplevel.cgi\">"
foreach i $treelist {
if {![info exists treeinfo($i,nobonsai)]} {
puts "<INPUT TYPE=radio NAME=treeid VALUE=$i [IsChecked $i]>"
puts "$treeinfo($i,description)<BR>"
}
}
puts "<INPUT TYPE=SUBMIT Value=\"Submit\"></FORM>"
PutsTrailer
exit

12
webtools/bonsai/testlock.pl Executable file
Просмотреть файл

@ -0,0 +1,12 @@
#!/usr/bonsaitools/bin/perl --
# -*- Mode: perl; indent-tabs-mode: nil -*-
require 'utils.pl';
Lock();
print "Got lock.\n";
sleep 10;
Unlock();

261
webtools/bonsai/toplevel.cgi Executable file
Просмотреть файл

@ -0,0 +1,261 @@
#!/usr/bonsaitools/bin/mysqltcl
# -*- Mode: tcl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Bonsai CVS tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
source CGI.tcl
Lock
LoadCheckins
LoadMOTD
LoadWhiteboard
LoadTreeConfig
Unlock
if {$treeopen} {
set openword Open
} else {
set openword Closed
}
puts "Content-type: text/html
Refresh: 300
<HTML>
<TITLE>($openword) Bonsai -- the art of effectively controlling trees</TITLE>
<IMG ALIGN=right SRC=bonsai.gif>
<H1>Bonsai -- Tree Control</H1>
<FORM name=treeform>
<H3>
<SELECT name=treeid size=1 onchange='submit();'>
"
# <SELECT name=treeid size=1 onchange='window.location =\"toplevel.cgi?treeid=\" + treeform.treeid.value;'>
foreach t $treelist {
if {![info exists treeinfo($t,nobonsai)]} {
if {[cequal $t $treeid]} {
set c "SELECTED"
} else {
set c ""
}
puts "<OPTION VALUE=$t $c>$treeinfo($t,description)"
}
}
puts "</SELECT></H3></FORM>"
if {$readonly} {
puts "<h2><font color=red>Be aware that you are looking at an old hook!</font></h2>"
}
puts "<tt>[fmtclock [getclock] "%R"]</tt>: The tree is currently <B>"
if {$treeopen} {
puts "<FONT SIZE=+2>OPEN</FONT></B><BR>"
} else {
puts "<FONT SIZE=+3 COLOR=RED>CLOSED</FONT></B><BR>"
}
if {!$treeopen} {
puts "The tree has been closed since <tt>[MyFmtClock $closetimestamp]</tt>."
}
puts "<BR>"
puts "The last known good tree had a timestamp "
puts "of <tt>[fmtclock $lastgoodtimestamp "%D %T %Z"]</tt>.<br>"
puts "<hr><pre variable>$motd</pre><hr>"
puts "<br clear=all>"
# if {[info exists FORM(whitedelta)]} {
# set delta $FORM(whitedelta)
# } else {
# set delta [expr 24 * 60 * 60]
# }
#
# set fileok 0
# set filename [DataDir]/whitedelta-$delta
# if {[file exists $filename]} {
# if {[file mtime $filename] > [file mtime [DataDir]/whiteboard]} {
# set fileok 1
# }
# }
#
# if {!$fileok} {
# set tmp [DataDir]/tmpwhite.[id process]
# Lock
# set date [fmtclock [expr [getclock] - $delta] "%a %b %d %H:%M:%S LT %Y"]
# catch {exec co -q -d$date -p [DataDir]/whiteboard > $tmp 2> /dev/null}
# catch {chmod 0666 $tmp}
# exec ./changebar.tcl $tmp [DataDir]/whiteboard > $filename
# unlink $tmp
# catch {chmod 0666 $filename}
# Unlock
# }
#puts "<b><a href=editwhiteboard.cgi[BatchIdPart ?]>Free-for-all whiteboard:</a></b> (Changebars indicate changes within last [PrettyDelta $delta])<pre>[html_quote [read_file $filename]]</pre><hr>"
puts "<b><a href=editwhiteboard.cgi[BatchIdPart ?]>Free-for-all whiteboard:</a></b><pre>[html_quote $whiteboard]</pre><hr>"
foreach c $checkinlist {
upvar #0 $c info
lappend people($info(person)) $c
if {!$info(treeopen)} {
lappend closedcheckin($info(person)) $c
}
}
if {[info exists people]} {
puts "The following people are on \"the hook\", since they have made"
puts "checkins to the tree since it last opened: "
puts "<p>"
set peoplelist [lsort [array names people]]
set query "(| "
foreach p $peoplelist {
append query "(mail=$p@netscape.com) "
set fullname($p) ""
set curcontact($p) ""
}
append query ")"
set ldaperror 0
if {[catch {set fid [open "|./data/ldapsearch -b \"o=Netscape Communications Corp.,c=US\" -h $ldapserver -p $ldapport -s sub -S mail \"$query\" mail cn nscpcurcontactinfo" r]} errvar]} {
set ldaperror 1
} else {
set doingcontactinfo 0
while {[gets $fid line] >= 0} {
if {$doingcontactinfo} {
if {[regexp -- {^ (.*)$} $line foo n]} {
append curcontact($curperson) $n
continue
}
set doingcontactinfo 0
}
if {[regexp -- {^mail: (.*)@} $line foo n]} {
set curperson $n
} elseif {[regexp -- {^cn: (.*)$} $line foo n]} {
set fullname($curperson) $n
} elseif {[regexp -- {^nscpcurcontactinfo: (.*)$} $line foo n]} {
set curcontact($curperson) $n
set doingcontactinfo 1
}
}
if {[catch {close $fid} errvar]} {
set ldaperror 1
}
}
if {$ldaperror} {
puts "<font color=red>Can't contact the directory server at $ldapserver:$ldapport -- $errvar</font>"
}
puts "<table border cellspacing=2>"
puts "<th colspan=2>Who</th><th>What</th><th>How to contact</th>"
foreach p $peoplelist {
if {[info exists closedcheckin($p)]} {
set extra " <font color=red>([llength $closedcheckin($p)] while tree closed!)</font>"
} else {
set extra ""
}
puts "
<tr>
<td>$fullname($p)</a></td>
<td><a href=\"http://phonebook/ds/dosearch/phonebook/uid=[url_quote "$p,ou=People,o= Netscape Communications Corp.,c=US"]\">
$p</td>
<td><a href=\"showcheckins.cgi?person=$p[BatchIdPart]\">[llength $people($p)]
[Pluralize change [llength $people($p)]]</a>$extra</td>"
puts "
<td>$curcontact($p)
</tr>"
}
puts "</table>"
puts "[llength $checkinlist] checkins."
if {[cequal $treeid default]} {
set mailaddr "bonsai-hook"
} else {
set f [open data/$treeid/hooklist r]
set fileEOF [gets $f hookentry]
set theHookList {}
while { $fileEOF != -1 } {
set theHookList [concat $theHookList $hookentry]
set fileEOF [gets $f hookentry]
}
set mailaddr "$theHookList"
}
puts "<p>"
puts "<a href=showcheckins.cgi[BatchIdPart ?]>Show all checkins.</a><br>"
if {[cequal $treeid default]} {
puts "<a href=\"mailto:[set mailaddr]@warp?subject=Build problem\">"
} else {
puts "<a href=\"mailto:[set mailaddr]?subject=Build problem\">"
}
puts "Send mail to \"the hook\".</a><br>"
} else {
puts "Nobody seems to have made any changes since the tree opened."
}
set cvsqueryurl "cvsqueryform.cgi?cvsroot=$treeinfo($treeid,repository)&module=$treeinfo($treeid,module)"
if {[clength $treeinfo($treeid,branch)] > 0} {
append cvsqueryurl "&branch=$treeinfo($treeid,branch)"
}
puts "
<hr>
<table>
<tr>
<th>Useful links </th><th width=10%></th><th>Help corner</th>
</tr>
<tr>
<td valign=top>
<a href=$cvsqueryurl><b>CVS Query Tool</b></a><br>
<a href=http://warp/tinderbox/showbuilds.cgi>Tinderbox continuous builds</a><br>
<a href=\"switchtree.cgi[BatchIdPart ?]\">Switch to look at a different tree or branch</a><br>
<a href=\"news:mcom.dev.client.build.busted\">Look at the Busted Tree Newsgroup</a><br>
<a href=http://phonebook/>Look up someone in the phonebook.</a><br>
<a href=viewold.cgi[BatchIdPart ?]>Time warp -- view a different day's hook.</a><br>
<a href=countcheckins.cgi[BatchIdPart ?]>See some stupid statistics about recent checkins.</a><br>
<a href=admin.cgi[BatchIdPart ?]>Administration menu.</a><br>
</td><td>
</td><td valign=top>
<a href=index.html>Introduction to Bonsai.</a><br>
<a href=http://warp/client/dogbert/tree.html>Overview of our source tree strategy.</a><br>
<a href=contacthelp.html>Changing someone else's contact info (yes you can!)</a><br>
<a href=http://warp/client/dogbert/buildlore/index.html>Dogbert build lore</a>
</td>
</tr></table>
"
exit

7
webtools/bonsai/trapdoor.c Normal file
Просмотреть файл

@ -0,0 +1,7 @@
#include <stdio.h>
#include <crypt.h>
main(int argc, char** argv) {
printf("%s\n", crypt(argv[1], "aa"));
return 0;
}

131
webtools/bonsai/utils.pl Normal file
Просмотреть файл

@ -0,0 +1,131 @@
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Bonsai CVS tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
use Mysql;
require 'header.pl';
$lockcount = 0;
1;
sub Lock {
if ($lockcount <= 0) {
$lockcount = 0;
if (!open(LOCKFID, ">>data/lockfile")) {
mkdir "data", 0777;
chmod 0777, "data";
open(LOCKFID, ">>data/lockfile") || die "Can't open lockfile.";
}
my $val = flock(LOCKFID,2);
if (!$val) { # '2' is magic 'exclusive lock' const.
print "Lock failed: $val\n";
}
chmod 0666, "data/lockfile";
}
$lockcount++;
}
sub Unlock {
$lockcount--;
if ($lockcount <= 0) {
flock(LOCKFID,8); # '8' is magic 'unlock' const.
close LOCKFID;
}
}
sub loadConfigData {
if (@treelist > 0) {return;}
local($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
$atime,$pmtime,$ctime,$blksize,$blocks) = stat("data/configdata.pl");
local $tmtime;
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
$atime,$tmtime,$ctime,$blksize,$blocks) = stat("data/configdata");
if ($pmtime eq "" || $pmtime < $tmtime) {
system "./perlifyconfig.tcl";
}
open(CONFIGDATA, "<data/configdata.pl") || die "Can't open configdata.pl";
while (<CONFIGDATA>) {
eval;
}
close CONFIGDATA;
}
sub pickDefaultRepository {
loadConfigData();
return $treeinfo{$treelist[0]}->{'repository'};
}
sub getRepositoryList {
loadConfigData();
my @result = ();
TREELOOP: foreach my $i (@treelist) {
my $r = $treeinfo{$i}->{'repository'};
foreach my $j (@result) {
if ($j eq $r) {
next TREELOOP;
}
}
push @result, $r;
}
return @result;
}
sub validateRepository {
my ($root) = @_;
my @list = getRepositoryList();
foreach my $r (@list) {
if ($r eq $root) {
return;
}
}
print "Invalid repository $root selected. Send mail to terry\@netscape.com if you think this should have worked.\n";
exit;
}
sub ConnectToDatabase {
if ($dbh == "") {
$dbh = Mysql->Connect("localhost") || die "Can't connect to database server -- $Mysql::db_errstr";
$dbh->SelectDB("bonsai") || die "Can't select bonsai database";
}
return $dbh;
}
sub formatSqlTime {
my $when = @_[0];
my($sec,$minute,$hour,$mday,$mon,$year) = localtime( $when );
return sprintf("%04d-%02d-%02d %02d:%02d:%02d",
$year + 1900, $mon + 1, $mday,
$hour, $minute, $sec);
}
sub SqlQuote {
$_ = @_[0];
s/'/''/g;
s/\\/\\\\/g;
return $_;
}

73
webtools/bonsai/viewold.cgi Executable file
Просмотреть файл

@ -0,0 +1,73 @@
#!/usr/bonsaitools/bin/mysqltcl
# -*- Mode: tcl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Bonsai CVS tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
source CGI.tcl
LoadCheckins
proc IsChecked {value} {
global batchid
if {[cequal $value $batchid]} {
return "CHECKED"
} else {
return ""
}
}
puts "Content-type: text/html
<HTML>
<TITLE>Let's do the time warp again...</TITLE>
Which hook would you like to see?
"
set list {}
foreach i [glob "[DataDir]/batch-*\[0-9\]"] {
regexp -- {[0-9]*$} $i num
lappend list $num
}
set list [lsort -integer -decreasing $list]
puts "<FORM method=get action=\"toplevel.cgi\">"
puts "<INPUT TYPE=HIDDEN NAME=treeid VALUE=$treeid>"
puts "<INPUT TYPE=SUBMIT Value=\"Submit\"><BR>"
set value [lvarpop list]
puts "<INPUT TYPE=radio NAME=batchid VALUE=$value [IsChecked $value]>"
puts "The current hook.<BR>"
set count 1
foreach i $list {
set value [lvarpop list]
puts "<INPUT TYPE=radio NAME=batchid VALUE=$value [IsChecked $value]>"
source [DataDir]/batch-$i
puts "Hook for tree that closed on [MyFmtClock $closetimestamp] <BR>"
}
puts "<INPUT TYPE=SUBMIT Value=\"Submit\">"
puts "</FORM>"
PutsTrailer
exit

102
webtools/registry/file.cgi Executable file
Просмотреть файл

@ -0,0 +1,102 @@
#!/usr/bonsaitools/bin/perl
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Application Registry.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
require 'lloydcgi.pl';
$|=1;
$filename= $form{"file"};
$dirname= $form{"dir"};
$branch= $form{"branch"};
$cvsroot= $form{"cvsroot"};
$rev= $form{"rev"};
$prev_rev= $form{"prev_rev"};
$linked_text= $form{"linked_text"};
$linked_text = $filename if $linked_text eq '';
$branch = $rev if $branch eq '' && $rev =~ /[A-Za-z]/;
@extra_url = ();
@extra_text = ();
print "Content-type: text/html\n\n<HTML>\n";
print "<table border=1 cellspacing=1 cellpadding=3><tr><td>\n";
&load_extra_data;
$i = 0;
while( $i < @extra_text ){
$t = $extra_text[$i];
if( $u = $extra_url[$i] ){
print("<dt><a href=$u>$t</a>\n");
}
else {
print("<dt>$t\n");
}
$i++;
}
if( @extra_text ){
print("<hr>\n");
}
$dirname2 = $dirname;
$dirname2 =~ s/^ns\///;
print "
$linked_text
<SPACER TYPE=VERTICAL SIZE=5>
<dt><A HREF=../bonsai/cvsblame.cgi?file=$dirname/$filename&rev=$rev&root=$cvsroot>
View Blame-Annotated Source</A>
";
if ($prev_rev ne '') {
print "<dt><A HREF='../bonsai/cvsview2.cgi"
."?diff_mode=context&whitespace_mode=show"
."&root=$cvsroot&subdir=$dirname&command=DIFF_FRAMESET&file=$filename"
."&rev1=$rev&rev2=$prev_rev'>View Diff $prev_rev vs. $rev</A>";
} else {
print "<dt><A HREF='../bonsai/cvsview2.cgi?subdir=$dirname"
."\&files=$filename\&command=DIRECTORY&branch=$branch&root=$cvsroot'>"
."View Diff's</A>";
}
print "<DT><A HREF='../bonsai/cvslog.cgi?file=$dirname/$filename&rev=$rev&root=$cvsroot'>
View Logs</A>
";
print "
</td></tr></table>";
sub load_extra_data {
local( $i, $u, $t );
$i = 0;
while( ($u = $form{"u${i}"}) ne "" || $form{"t${i}"} ne "" ) {
$t = $form{"t${i}"};
if( $t eq "" ) {$t = $u };
$extra_url[$i] = $u;
$extra_text[$i] = $t;
$i++;
}
}

44
webtools/registry/lloydcgi.pl Executable file
Просмотреть файл

@ -0,0 +1,44 @@
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Application Registry.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
&split_cgi_args;
1;
sub split_cgi_args {
local($i,$var,$value, $s);
if( $ENV{"REQUEST_METHOD"} eq 'POST'){
while(<> ){
$s .= $_;
}
}
else {
$s = $ENV{"QUERY_STRING"};
}
@args= split(/\&/, $s );
for $i (@args) {
($var, $value) = split(/=/, $i);
$var =~ tr/+/ /;
$var =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$form{$var} = $value;
}
}

82
webtools/registry/who.cgi Executable file
Просмотреть файл

@ -0,0 +1,82 @@
#!/usr/bonsaitools/bin/perl
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Application Registry.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
require 'lloydcgi.pl';
$|=1;
$email= $form{"email"};
$full_name = $email;
$enc_full_name = $email; #this should be url encoded
@extra_url = ();
@extra_text = ();
print "Content-type: text/html\n\n<HTML>\n";
print "<table border=1 cellspacing=1 cellpadding=3><tr><td>\n";
print "$email\n";
print "<SPACER TYPE=VERTICAL SIZE=5>\n";
&load_extra_data;
$i = 0;
while( $i < @extra_text ){
$t = $extra_text[$i];
if( $u = $extra_url[$i] ){
print("<dt><a href=$u>$t</a>\n");
}
else {
print("<dt>$t\n");
}
$i++;
}
if( @extra_text ){
print("<hr>\n");
}
print "
<dt><A HREF='mailto:$email\@netscape.com'>
Send Mail</A>
<dt><A HREF='../bonsai/cvsquery.cgi?module=all&branch=&dir=&file=&who=$email&sortby=Date&hours=2&date=week&mindate=&maxdate='>
Check-ins within 7 days</A>
</table>
<form method='post' name='aka' action='http://aka/aka/snoop-reverse-cache.cgi'>
<input type=hidden name=alias value='$email'> </form>
";
sub load_extra_data {
local( $i, $u, $t );
$i = 0;
while( ($u = $form{"u${i}"}) ne "" || $form{"t${i}"} ne "" ) {
$t = $form{"t${i}"};
if( $t eq "" ) {$t = $u };
$extra_url[$i] = $u;
$extra_text[$i] = $t;
$i++;
}
}

Двоичные данные
webtools/tinderbox/1afi003r.gif Normal file
Просмотреть файл

Двоичный файл не отображается.
Режим "рядом"

После

Ширина:  |  Высота:  |  Размер: 13 KiB

1
webtools/tinderbox/Empty.html Normal file
Просмотреть файл

@ -0,0 +1 @@
<font size=+2>Click on the <b>filename and line number</b> in the log and the source will appear in this window.</font>

73
webtools/tinderbox/README Normal file
Просмотреть файл

@ -0,0 +1,73 @@
This is Tinderbox. See <http://www.mozilla.org/tinderbox.html>.
==========
DISCLAIMER
==========
This is not very well packaged code. It's not packaged at all. Don't
come here expecting something you plop in a directory, twiddle a few
things, and you're off and using it. Much work has to be done to get
there. I'd like to get there, but it wasn't clear when that would be,
and so we decided to let people see it first.
Don't believe for a minute that you can use this stuff without first
understanding most of the code.
============
DEPENDENCIES
============
To use tinderbox, you must first have bonsai up and running.
See <http://www.mozilla.org/bonsai.html>.
Be warned now that bonsai is not easily installed.
====================================
What's What in the Tinderbox sources:
====================================
1afi003r.gif The "flames" animation used by ???
Empty.html Document used for an empty frame by ???
addimage.cgi The form that lets you add a new image to the list of
images that Tinderbox picks from randomly.
addnote.cgi Add a note to a build log.
admintree.cgi Lets you perform various admin tasks on a Tinderbox tree.
This just prompts for a password and posts to doadmin.cgi.
buildwho.pl ???
clean.pl ???
copydata.pl ???
doadmin.cgi Actually do the work to admin a tinderbox tree
ep_mac.pl Knows how to parse Mac build error logs. Used by ???
ep_unix.pl Knows how to parse Unix build error logs. Used by ???
ep_windows.pl Knows how to parse Windows build error logs. Used by ???
faq.html Wildly out of date.
fixupimages.pl ???
globals.pl ???
handlemail.pl ???
imagelog.pl ???
index.html ???
processbuild.pl ???
reledanim.gif ???
showbuilds.cgi The main Tinderbox page. Interesting params are:
express=1; hours=n; tree2=anothertree.
showimages.cgi Show all the images in the Tinderbox list. Password-protected.
showlog.cgi Show a build log (brief and full).
star.gif The "star" image used to annotate builds by ???

402
webtools/tinderbox/addimage.cgi Executable file
Просмотреть файл

@ -0,0 +1,402 @@
#!/usr/bonsaitools/bin/perl --
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Tinderbox build tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
use Socket;
use lib "../bonsai";
require 'header.pl';
print "Content-type: text/html\n\n";
EmitHtmlTitleAndHeader("tinderbox: add images", "add images");
$| = 1;
require "globals.pl";
require "imagelog.pl";
&split_cgi_args;
sub Error {
my ($msg) = @_;
print "<BR><BR><BR>";
print "<UL><FONT SIZE='+1'><B>Something went wrong:</B><P>";
print "<UL>";
print $msg;
print "</UL>";
print "<P>";
print "Hit <B>\`Back'</B> and try again.";
print "</UL>";
exit 1;
}
if( $url = $form{"url"} ){
$quote = $form{"quote"};
$quote =~ s/[\r\n]/ /g;
$url =~ s/[\r\n]/ /g;
$width = "";
$height = "";
# I think we don't want to allow this --jwz
# $width = $form{"width"};
# $height = $form{"height"};
if ($width eq "" || $height eq "") {
$size = &URLsize($url);
if ($size =~ /WIDTH=([0-9]*)/) {
$width = $1;
}
if ($size =~ /HEIGHT=([0-9]*)/) {
$height = $1;
}
if ($width eq "" || $height eq "") {
Error "Couldn't get image size for \"$url\".\n";
}
}
print "
<P><center><img border=2 src='$url' width=$width height=$height><br>
<i>$quote</i><br><br>
";
if( $form{"submit"} ne "Yes" ){
my $u2 = $url;
my $q2 = $quote;
$u2 =~ s@&@&amp;@g; $u2 =~ s@<@&lt;@g; $u2 =~ s@\"@&quot;@g;
$q2 =~ s@&@&amp;@g; $q2 =~ s@<@&lt;@g; $q2 =~ s@\"@&quot;@g;
print "
<form action='addimage.cgi' METHOD='get'>
<input type=hidden name=url value=\"$u2\">
<input type=hidden name=quote value=\"$q2\">
<HR>
<TABLE>
<TR>
<TH ALIGN=RIGHT NOWRAP>Image URL:</TH>
<TD><TT><B>$u2</B></TT></TD>
</TR><TR>
<TH ALIGN=RIGHT>Caption:</TH>
<TD><TT><B>$q2</B></TT></TD>
</TR>
<TR>
<TD></TD>
<TD>
<FONT SIZE=+2><B>
Does that look right?
<SPACER SIZE=10>
<INPUT Type='submit' name='submit' value='Yes'>
</B><BR>(If not, hit \`Back' and fix it.)
</FONT>
</TD>
</TABLE>
</form>
";
}
else {
&add_imagelog( $url, $quote, $width, $height );
print "<br><br>
<font size=+2>Has been added</font><br><br>
<a href=showbuilds.cgi>Return to Log</a>";
}
}
else {
print "
<h2>Add an image and a funny caption.</h2>
<ul>
<p>This is about fun, and making your daily excursion to
<A HREF=http://www.mozilla.org/tinderbox.html>Tinderbox</A> a
novel experience. Engineers spend a lot of time here; it might as well
have some entertainment value.
<p>Please play nice. We don't have the time or inclination to look at
everything you people submit, but if we get nastygrams or legalgrams
and have to take something down, we will curse your IP address, and you
might even make it so the whole thing goes away forever. Please don't
make us go there. You might also avoid links to big images or slow
servers.
<p><ul><B>Thank you for playing nice.</B></UL>
<p>If you really find an image offensive, please
<A HREF=mailto:ltabb\@netscape.com?Subject=offensive%20image>tell us</A>
nicely before someone causes a stink. Be sure to include the URL of
the image. Remember, we don't screen these submissions and may not
have even seen it.
</ul>
<p><form action='addimage.cgi' METHOD='get'>
<TABLE>
<TR>
<TH ALIGN=RIGHT NOWRAP>Image URL:</TH>
<TD><INPUT NAME='url' SIZE=60></TD>
</TR><TR>
<TH ALIGN=RIGHT>Caption:</TH>
<TD><INPUT NAME='quote' SIZE=60></TD>
</TR><TR>
<TD></TD>
<TD><B>
<INPUT Type='submit' name='submit' value='Test'>
<SPACER SIZE=25>
<INPUT Type='reset' name='reset' value='Reset'>
</B></TD>
</TR>
</TABLE>
</form>
<br><br>
";
}
sub split_cgi_args {
local($i,$var,$value, $s);
$s = $ENV{"QUERY_STRING"};
@args= split(/\&/, $s );
for $i (@args) {
($var, $value) = split(/=/, $i);
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$form{$var} = $value;
}
}
#sub imgsize {
# local($file)= @_;
#
# #first try to open the file
# if( !open(STREAM, "<$file") ){
# Error "Can't open IMG $file";
## $size="";
# } else {
# if ($file =~ /.jpg/i || $file =~ /.jpeg/i) {
# $size = &jpegsize(STREAM);
# } elsif($file =~ /.gif/i) {
# $size = &gifsize(STREAM);
# } elsif($file =~ /.xbm/i) {
# $size = &xbmsize(STREAM);
# } else {
# return "";
# }
# $_ = $size;
# if( /\s*width\s*=\s*([0-9]*)\s*/i ){
# ($newwidth)= /\s*width\s*=\s*(\d*)\s*/i;
# }
# if( /\s*height\s*=\s*([0-9]*)\s*/i ){
# ($newheight)=/\s*height\s*=\s*(\d*)\s*/i;
# }
# close(STREAM);
# }
# return $size;
#}
###########################################################################
# Subroutine gets the size of the specified GIF
###########################################################################
# bug: it thinks that
# http://cvs1.mozilla.org/webtools/tinderbox/data/knotts.gif
# is 640x400, but it's really 200x245.
# giftrans says of that image:
#
# Header: "GIF87a"
# Logical Screen Descriptor:
# Logical Screen Width: 640 pixels
# Logical Screen Height: 480 pixels
# Image Descriptor:
# Image Width: 200 pixels
# Image Height: 245 pixels
sub gifsize {
local($GIF) = @_;
read($GIF, $type, 6);
if(!($type =~ /GIF8[7,9]a/) ||
!(read($GIF, $s, 4) == 4) ){
Error "Invalid or Corrupted GIF";
$size="";
} else {
($a,$b,$c,$d)=unpack("C"x4,$s);
$size=join ("", 'WIDTH=', $b<<8|$a, ' HEIGHT=', $d<<8|$c);
}
return $size;
}
sub xbmsize {
local($XBM) = @_;
local($input)="";
$input .= <$XBM>;
$input .= <$XBM>;
$_ = $input;
if( /#define\s*\S*\s*\d*\s*\n#define\s*\S*\s*\d*\s*\n/i ){
($a,$b)=/#define\s*\S*\s*(\d*)\s*\n#define\s*\S*\s*(\d*)\s*\n/i;
$size=join ("", 'WIDTH=', $a, ' HEIGHT=', $b );
} else {
Error "Doesn't look like an XBM file";
}
return $size;
}
# jpegsize : gets the width and height (in pixels) of a jpeg file
# Andrew Tong, werdna@ugcs.caltech.edu February 14, 1995
# modified slightly by alex@ed.ac.uk
sub jpegsize {
local($JPEG) = @_;
local($done)=0;
$size="";
read($JPEG, $c1, 1); read($JPEG, $c2, 1);
if( !((ord($c1) == 0xFF) && (ord($c2) == 0xD8))){
my $s = sprintf "This is not a JPEG! (Codes %02X %02X)\n", ord($c1), ord($c2);
Error $s;
$done=1;
}
while (ord($ch) != 0xDA && !$done) {
# Find next marker (JPEG markers begin with 0xFF)
# This can hang the program!!
while (ord($ch) != 0xFF) { read($JPEG, $ch, 1); }
# JPEG markers can be padded with unlimited 0xFF's
while (ord($ch) == 0xFF) { read($JPEG, $ch, 1); }
# Now, $ch contains the value of the marker.
$marker=ord($ch);
if (($marker >= 0xC0) && ($marker <= 0xCF) &&
($marker != 0xC4) && ($marker != 0xCC)) { # it's a SOFn marker
read ($JPEG, $junk, 3); read($JPEG, $s, 4);
($a,$b,$c,$d)=unpack("C"x4,$s);
$size=join("", 'HEIGHT=',$a<<8|$b,' WIDTH=',$c<<8|$d );
$done=1;
} else {
# We **MUST** skip variables, since FF's within variable
# names are NOT valid JPEG markers
read ($JPEG, $s, 2);
($c1, $c2) = unpack("C"x2,$s);
$length = $c1<<8|$c2;
if( ($length < 2) ){
Error "Bad JPEG file: erroneous marker length";
$done=1;
} else {
read($JPEG, $junk, $length-2);
}
}
}
return $size;
}
###########################################################################
# Subroutine grabs a gif from another server and gets its size
###########################################################################
sub URLsize {
my ($fullurl) = @_;
$_ = $fullurl;
if ( ! m@^http://@ ) {
Error "HTTP URLs only, please: \"$_\" is no good.";
}
my($dummy, $dummy, $serverstring, $url) = split(/\//, $fullurl, 4);
my($them,$port) = split(/:/, $serverstring);
my $port = 80 unless $port;
my $size="";
$_ = $them;
if ( m@^[^.]*$@ ) {
Error "Fully-qualified host names only, please: \"$_\" is no good.";
}
$_=$url;
my ($remote, $iaddr, $paddr, $proto, $line);
$remote = $them;
if ($port =~ /\D/) { $port = getservbyname($port, 'tcp') }
die "No port" unless $port;
$iaddr = inet_aton($remote) || die "no host: $remote";
$paddr = sockaddr_in($port, $iaddr);
$proto = getprotobyname('tcp');
socket(S, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
connect(S, $paddr) || die "connect: $!";
select(S); $| = 1; select(STDOUT);
print S "GET /$url HTTP/1.0\r\n";
print S "Host: $them\r\n";
print S "User-Agent: Tinderbox/0.0\r\n";
print S "\r\n";
$_ = <S>;
if (! m@^HTTP/[0-9.]+ 200@ ) {
Error "$them responded:<BR> $_";
}
my $ctype = "";
while (<S>) {
# print "read: $_<br>\n";
if ( m@^Content-Type:[ \t]*([^ \t\r\n]+)@io ) {
$ctype = $1;
}
last if (/^[\r\n]/);
}
$_ = $ctype;
if ( $_ eq "" ) {
Error "Server returned no content-type for \"$fullurl\"?";
} elsif ( m@image/jpeg@i || m@image/pjpeg@i ) {
$size = &jpegsize(S);
} elsif ( m@image/gif@i ) {
$size = &gifsize(S);
} elsif ( m@image/xbm@i || m@image/x-xbm@i || m@image/x-xbitmap@i ) {
$size = &xbmsize(S);
} else {
Error "Not a GIF, JPEG, or XBM: that was of type \"$ctype\".";
}
$_ = $size;
if( /\s*width\s*=\s*([0-9]*)\s*/i ){
($newwidth)= /\s*width\s*=\s*(\d*)\s*/i;
}
if( /\s*height\s*=\s*([0-9]*)\s*/i ){
($newheight)=/\s*height\s*=\s*(\d*)\s*/i;
}
if ( $newwidth eq "" || $newheight eq "" ) {
return "";
} else {
if ( $newwidth <= 5 || $newheight <= 5 ) {
Error "${newwidth}x${newheight} seems small, don't you think?";
} elsif ( $newwidth >= 400 || $newheight >= 400 ) {
Error "${newwidth}x${newheight} is too big; please" .
" keep it under 400x400."
}
return $size;
}
}
sub dokill {
kill 9,$child if $child;
}

86
webtools/tinderbox/addnote.cgi Executable file
Просмотреть файл

@ -0,0 +1,86 @@
#!/usr/bonsaitools/bin/perl --
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Tinderbox build tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
use lib "../bonsai";
require "globals.pl";
require 'lloydcgi.pl';
$buildname = $form{'buildname'};
$buildtime = $form{'buildtime'};
$errorparser = $form{'errorparser'};
$logfile = $form{'logfile'};
$tree = $form{'tree'};
$enc_buildname = &url_encode($buildname);
$note = $form{'note'};
$who = $form{'who'};
$now = time;
$now_str = &print_time($now);
$|=1;
print "Content-type: text/html\n\n<HTML>\n";
if( $url = $form{"note"} ){
$enc_note = url_encode( $note );
lock;
open( NOTES,">>$tree/notes.txt");
print NOTES "$buildtime|$buildname|$who|$now|$enc_note\n";
close(NOTES);
print "<H1>The following comment has been added to the log</h1>\n";
#print "$buildname \n $buildtime \n $errorparser \n $logfile \n $tree \n $enc_buildname \n";
print "<pre>\n[<b>$who - $now_str</b>]\n$note\n</pre>";
print"
<p><a href=\"showlog.cgi?tree=$tree\&buildname=$enc_buildname\&buildtime=$buildtime\&logfile=$logfile\&errorparser=$errorparser\">
Go back to the Error Log</a>
<a href=\"showbuilds.cgi?tree=$tree\">
<br>Go back to the build Page</a>
";
}
else {
if( $buildname eq '' || $buildtime == 0 ){
print "<h1>Invalid parameters</h1>\n";
die "\n";
}
#print "$buildname \n $buildtime \n $errorparser \n $logfile \n $tree \n $enc_buildname \n";
print "
<title>Add a Comment to the log</title>
<H1>Add a Comment to the log</h1>
<form action='addnote.cgi' METHOD='post'>
<br>Your email address: <INPUT Type='input' name='who' size=10>
<TEXTAREA NAME=note ROWS=10 COLS=70>
</textarea>
<INPUT Type='hidden' name='buildname' value='${buildname}'>
<INPUT Type='hidden' name='buildtime' value='${buildtime}'>
<INPUT Type='hidden' name='errorparser' value='$errorparser'>
<INPUT Type='hidden' name='logfile' value='$logfile'>
<INPUT Type='hidden' name='tree' value='$tree'>
<INPUT Type='submit' name='submit' value='Add Note To Log'>
</form>
";
}

114
webtools/tinderbox/admintree.cgi Executable file
Просмотреть файл

@ -0,0 +1,114 @@
#!/usr/bonsaitools/bin/perl --
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Tinderbox build tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
use lib "../bonsai";
require 'lloydcgi.pl';
require 'globals.pl';
require 'header.pl';
$|=1;
print "Content-type: text/html\n\n<HTML>\n";
EmitHtmlHeader("administer tinderbox", "tree: $tree");
&load_data;
if( -r "$tree/mod.pl" ){
require "$tree/mod.pl";
}
else {
$message_of_day = "";
}
print "
<FORM method=post action=doadmin.cgi>
<B>Password:</B> <INPUT NAME=password TYPE=password>
<INPUT TYPE=HIDDEN NAME=tree VALUE=$tree>
<INPUT TYPE=HIDDEN NAME=command VALUE=set_message>
<br><b>Message of the Day
<br><TEXTAREA NAME=message ROWS=10 COLS=70>$message_of_day
</TEXTAREA>
<br><INPUT TYPE=SUBMIT VALUE='Set Message of the Day'>
</FORM>
<hr>
";
print "
<FORM method=post action=doadmin.cgi>
<B>Password:</B> <INPUT NAME=password TYPE=password>
<INPUT TYPE=HIDDEN NAME=tree VALUE=$tree>
<INPUT TYPE=HIDDEN NAME=command VALUE=trim_logs>
<br><b>Trim Logs to <INPUT NAME=days size=5 VALUE='7'> days.</b> (Tinderbox
shows 2 days history by default. You can see more by clicking show all).
<br><INPUT TYPE=SUBMIT VALUE='Trim Logs'>
</FORM>
<FORM method=post action=doadmin.cgi>
<hr>
" ;
print "
<FORM method=post action=doadmin.cgi>
<B>Password:</B> <INPUT NAME=password TYPE=password> <BR>
<INPUT TYPE=HIDDEN NAME=tree VALUE=$tree>
<INPUT TYPE=HIDDEN NAME=command VALUE=create_tree>
<TABLE>
<TR>
<TD><B>tinderbox tree name:</B></TD>
<TD><INPUT NAME=treename VALUE=''></TD>
</TR><TR>
<TD><B>cvs module name:</B></TD>
<TD><INPUT NAME=modulename VALUE=''></TD>
</TR><TR>
<TD><B>cvs branch:</B></TD>
<TD><INPUT NAME=branchname VALUE='HEAD'></TD>
</TR>
</TABLE>
<INPUT TYPE=SUBMIT VALUE='Create a new Tinderbox page'>
</FORM>
<FORM method=post action=doadmin.cgi>
<hr>
<B>Password:</B> <INPUT NAME=password TYPE=password> <BR>
<INPUT TYPE=HIDDEN NAME=tree VALUE=$tree>
<INPUT TYPE=HIDDEN NAME=command VALUE=remove_build>
";
$i = 1;
while( $i <= $name_count ){
$n = $build_name_names->[$i];
print "<INPUT TYPE=radio NAME=build VALUE='$n'>";
print "$n<br>\n";
$i++;
}
print "
<INPUT TYPE=SUBMIT VALUE='Remove Build From Page'>
</FORM>
<hr>
";

90
webtools/tinderbox/buildwho.pl Executable file
Просмотреть файл

@ -0,0 +1,90 @@
#!/usr/bonsaitools/bin/perl --
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Tinderbox build tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
use lib "../bonsai";
require 'globals.pl';
$F_DEBUG=1;
$tree = $ARGV[0];
open(SEMFILE, ">>$tree/buildwho.sem") || die "Couldn't open semaphore file!";
if (!flock(SEMFILE, 2 + 4)) { # 2 means "lock"; 4 means "fail immediately if
# lock already taken".
print "buildwho.pl: Another process is currently building the database.\n";
exit(0);
}
require "$tree/treedata.pl";
if( $cvs_root eq '' ){
$CVS_ROOT = '/m/src';
}
else {
$CVS_ROOT = $cvs_root;
}
$CVS_REPOS_SUFIX = $CVS_ROOT;
$CVS_REPOS_SUFIX =~ s/\//_/g;
$CHECKIN_DATA_FILE = "/d/webdocs/projects/bonsai/data/checkinlog${CVS_REPOS_SUFIX}";
$CHECKIN_INDEX_FILE = "/d/webdocs/projects/bonsai/data/index${CVS_REPOS_SUFIX}";
require 'cvsquery.pl';
print "cvsroot='$CVS_ROOT'\n";
&build_who;
flock(SEMFILE, 8); # '8' is magic 'unlock' const.
close SEMFILE;
sub build_who {
open(BUILDLOG, "<$tree/build.dat" );
$line = <BUILDLOG>;
close(BUILDLOG);
#($j,$query_date_min) = split(/\|/, $line);
$query_date_min = time - (60 * 60 * 40);
if( $F_DEBUG ){
print "Minimum date: $query_date_min\n";
}
$query_module=$cvs_module;
$query_branch=$cvs_branch;
$result = &query_checkins;
$last_who='';
$last_date=0;
open(WHOLOG, ">$tree/who.dat" );
for $ci (@$result) {
if( $ci->[$CI_DATE] != $last_date || $ci->[$CI_WHO] != $last_who ){
print WHOLOG "$ci->[$CI_DATE]|$ci->[$CI_WHO]\n";
}
$last_who=$ci->[$CI_WHO];
$last_date=$ci->[$CI_DATE];
}
close( WHOLOG );
}

32
webtools/tinderbox/clean.pl Executable file
Просмотреть файл

@ -0,0 +1,32 @@
#!/usr/bonsaitools/bin/perl --
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Tinderbox build tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
chdir '/d/webdocs/projects/tinderbox';
#print "cd ok\n";
open FL, "find . -name \"*.gz\" -mtime +7 -print |";
#print "find ok\n";
while( <FL> ){
chop();
#print "unlink $_\n";
unlink $_;
}

91
webtools/tinderbox/copydata.pl Executable file
Просмотреть файл

@ -0,0 +1,91 @@
#!/tools/ns/bin/perl5
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Tinderbox build tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
#
# to run this script execute 'nohup copydata.pl &' from the tinderbox directory
#
$start_dir = `pwd`;
chop($start_dir);
$scp_cmd = "scp -o 'User snapshot' -o'Port 22' -o 'UserKnownHostsFile /u/shaver/snapshot/known_hosts' -o 'IdentityFile /u/shaver/snapshot/identity'";
$last_time = 0;
$min_cycle_time = 3 * 60; # 3 minutes
print "starting dir is :$start_dir\n";
while( 1 ){
chdir("$start_dir");
if( time - $last_time < $min_cycle_time ){
$sleep_time = $min_cycle_time - (time - $last_time);
print "\n\nSleeping $sleep_time seconds ...\n";
sleep( $sleep_time );
}
&copy_data("Mozilla");
&copy_data("raptor");
chdir( "$start_dir");
print "$scp_cmd * cvs1.mozilla.org:/e/webtools/tinderbox\n";
system "$scp_cmd * cvs1.mozilla.org:/e/webtools/tinderbox";
chdir( "$start_dir/../bonsai");
print "$scp_cmd * cvs1.mozilla.org:/e/webtools/bonsai\n";
system "$scp_cmd * cvs1.mozilla.org:/e/webtools/bonsai";
$last_time = time;
}
1;
sub copy_data {
local($data_dir) = @_;
local($zips,$qry);
chdir $data_dir || die "couldn't chdir to $data_dir";
system "echo hello >lastup.new";
if( -r 'lastup' ) {
$qry = '-newer lastup.old';
rename 'lastup', 'lastup.old'
}
rename 'lastup.new', 'lastup';
open( FINDER, "find . $qry -name \"*.gz\" -print|" );
while(<FINDER>){
print;
chop;
$zips .= "$_ ";
}
close( FINDER );
unlink 'lastup.old';
print "$scp_cmd *.txt $zips *.dat cvs1.mozilla.org:/e/webtools/tinderbox/$data_dir\n";
system "$scp_cmd *.txt $zips *.dat cvs1.mozilla.org:/e/webtools/tinderbox/$data_dir";
chdir $start_dir || die "couldn't chdir to $start_dir";
}

174
webtools/tinderbox/doadmin.cgi Executable file
Просмотреть файл

@ -0,0 +1,174 @@
#!/usr/bonsaitools/bin/perl --
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Tinderbox build tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
use lib "../bonsai";
require 'lloydcgi.pl';
require 'globals.pl';
umask O666;
$|=1;
check_password();
print "Content-type: text/html\n\n<HTML>\n";
$command = $form{'command'};
$tree= $form{'tree'};
if( $command eq 'create_tree' ){
&create_tree;
}
elsif( $command eq 'remove_build' ){
&remove_build;
}
elsif( $command eq 'trim_logs' ){
&trim_logs;
}
elsif( $command eq 'set_message' ){
&set_message;
} else {
print "Unknown command: \"$command\".";
}
sub trim_logs {
$days = $form{'days'};
$tree = $form{'tree'};
print "<h2>Trimming Log files for $tree...</h2>\n<p>";
$min_date = time - (60*60*24 * $days);
#
# Nuke the old log files
#
$i = 0;
opendir( D, 'DogbertTip' );
while( $fn = readdir( D ) ){
if( $fn =~ /\.gz$/ ){
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,
$ctime,$blksize,$blocks) = stat("$tree/$fn");
if( $mtime && ($mtime < $min_date) ){
print "$fn\n";
$tblocks += $blocks;
unlink( "$tree/$fn" );
$i++;
}
}
}
closedir( D );
$k = $tblocks*512/1024;
print "<br><b>$i Logfiles ( $k K bytes ) removed</b><br>\n";
#
# Trim build.dat
#
$builds_removed = 0;
open(BD, "<$tree/build.dat");
open(NBD, ">$tree/build.dat.new");
while( <BD> ){
($mailtime,$buildtime,$buildname) = split( /\|/ );
if( $buildtime >= $min_date ){
print NBD $_;
}
else {
$builds_removed++;
}
}
close( BD );
close( NBD );
rename( "$tree/build.dat", "$tree/build.dat.old" );
rename( "$tree/build.dat.new", "$tree/build.dat" );
print "<h2>$builds_removed Builds removed from build.dat</h2>\n";
}
sub create_tree {
$treename = $form{'treename'};
$modulename = $form{'modulename'};
$branchname = $form{'branchname'};
if( -r $treename ){
chmod 0777, $treename;
}
else {
mkdir( $treename, 0777 ) || die "<h1> Cannot mkdir $treename</h1>";
}
open( F, ">$treename/treedata.pl" );
print F "\$cvs_module='$modulename';\n";
print F "\$cvs_branch='$branchname';\n";
close( F );
open( F, ">$treename/build.dat" );
close( F );
open( F, ">$treename/who.dat" );
close( F );
open( F, ">$treename/notes.txt" );
close( F );
chmod 0777, "$treename/build.dat", "$treename/who.dat", "$treename/notes.txt",
"$treename/treedata.pl";
print "<h2><a href=showbuilds.cgi?tree=$treename>Tree created or modified</a></h2>\n";
}
sub remove_build {
$build_name = $form{'build'};
#
# Trim build.dat
#
$builds_removed = 0;
open(BD, "<$tree/build.dat");
open(NBD, ">$tree/build.dat.new");
while( <BD> ){
($mailtime,$buildtime,$bname) = split( /\|/ );
if( $bname ne $build_name ){
print NBD $_;
}
else {
$builds_removed++;
}
}
close( BD );
close( NBD );
chmod( 0777, "$tree/build.dat.new");
rename( "$tree/build.dat", "$tree/build.dat.old" );
rename( "$tree/build.dat.new", "$tree/build.dat" );
print "<h2><a href=showbuilds.cgi?tree=$tree>
$builds_removed Builds removed from build.dat</a></h2>\n";
}
sub set_message {
$m = $form{'message'};
$m =~ s/\"/\\\"/g;
open(MOD, ">$tree/mod.pl");
print MOD "\$message_of_day = \"$m\"";
close(MOD);
chmod( 0777, "$tree/mod.pl");
print "<h2><a href=showbuilds.cgi?tree=$tree>
Message Changed</a></h2>\n";
}

44
webtools/tinderbox/ep_mac.pl Executable file
Просмотреть файл

@ -0,0 +1,44 @@
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Tinderbox build tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
1;
#
# Scan a line and see if it has an error
#
sub has_error {
$line =~ /fatal error/ # link error
|| $line =~ /Error / # C error
|| $line =~ /\[checkout aborted\]/ #cvs error
;
}
sub has_warning {
$line =~ /^[A-Za-z0-9_]+\.[A-Za-z0-9]+\ line [0-9]+/ ;
}
sub has_errorline {
local( $line ) = @_;
if( $line =~ /^(([A-Za-z0-9_]+\.[A-Za-z0-9]+) line ([0-9]+))/ ){
$error_file = $1;
$error_file_ref = $2;
$error_line = $3;
$error_guess = 1;
return 1;
}
return 0;
}

59
webtools/tinderbox/ep_unix.pl Executable file
Просмотреть файл

@ -0,0 +1,59 @@
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Tinderbox build tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
1;
#
# Scan a line and see if it has an error
#
sub has_error {
$line =~ /fatal error/ # link error
|| $line =~ /^C / # cvs merge conflict
|| $line =~ / Error: / # C error
|| $line =~ / error\([0-9]*\)\:/ # C error
|| ($line =~ /gmake/ && $line =~ / Error /)
|| $line =~ /\[checkout aborted\]/ #cvs error
|| $line =~ /\: cannot find module/ #cvs error
;
}
sub has_warning {
$line =~ /^[A-Za-z0-9_]+\.[A-Za-z0-9]+\:[0-9]+\:/
|| $line =~ /^\"[A-Za-z0-9_]+\.[A-Za-z0-9]+\"\, line [0-9]+\:/
;
}
sub has_errorline {
local( $line ) = @_;
if( $line =~ /^(([A-Za-z0-9_]+\.[A-Za-z0-9]+)\:([0-9]+)\:)/ ){
$error_file = $1;
$error_file_ref = $2;
$error_line = $3;
$error_guess = 1;
return 1;
}
if ( $line =~ /^(\"([A-Za-z0-9_]+\.[A-Za-z0-9]+)\"\, line ([0-9]+)\:)/ ){
$error_file = $1;
$error_file_ref = $2;
$error_line = $3;
$error_guess = 1;
return 1;
}
return 0;
}

73
webtools/tinderbox/ep_windows.pl Executable file
Просмотреть файл

@ -0,0 +1,73 @@
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Tinderbox build tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
1;
#
# Scan a line and see if it has an error
#
sub has_error {
$line =~ /fatal error/ # link error
|| $line =~ / error / # C error
|| $line =~ /^C / # cvs merge conflict
|| $line =~ /error C/ # C error
|| $line =~ /Creating new precompiled header/ # Wastes time.
|| $line =~ /error:/ # java error
|| $line =~ /jmake.MakerFailedException:/ # java error
|| $line =~ /Unknown host / # cvs error
|| $line =~ /: build failed\;/ # nmake error
|| ($line =~ /gmake/ && $line =~ / Error /)
|| $line =~ /\[checkout aborted\]/ #cvs error
|| $line =~ /\: cannot find module/ #cvs error
;
}
sub has_warning {
$line =~ /: warning/ # link error
|| $line =~ / error / # C error
;
}
sub has_errorline {
local( $line ) = @_;
$error_file = ''; #'NS\CMD\WINFE\CXICON.cpp';
$error_line = 0;
if( $line =~ m@(ns([\\/][a-z0-9\._]+)*)@i ){
$error_file = $1;
$error_file_ref = lc $error_file;
$error_file_ref =~ s@\\@/@g;
$line =~ m/\(([0-9]+)\)/;
$error_line = $1;
return 1;
}
if( $line =~ m@(^([A-Za-z0-9_]+\.[A-Za-z])+\(([0-9]+)\))@ ){
$error_file = $1;
$error_file_ref = lc $2;
$error_line = $3;
$error_guess=1;
$error_file_ref =~ s@\\@/@g;
return 1;
}
return 0;
}

31
webtools/tinderbox/faq.html Executable file
Просмотреть файл

@ -0,0 +1,31 @@
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">
<HTML>
<HEAD>
<META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=iso-8859-1">
<META NAME="GENERATOR" CONTENT="Mozilla/4.0b2 (WinNT; I) [Netscape]">
</HEAD>
<BODY>
<H1>
FAQ on Tinderbox&nbsp;</H1>
<B><FONT SIZE=+2>Q. What is Tinderbox.</FONT></B>
<BR><FONT SIZE=+2>A. Your very own automated build page.&nbsp; It shows you how builds
are going on various platforms. fs</FONT>
<BR><FONT SIZE=+2></FONT>
<BR><B><FONT SIZE=+2>Q. I just checked in some code.&nbsp; How can I tell when
I'm OK.</FONT></B>
<BR><FONT SIZE=+2>A. You name will appear in the <I>guilty </I>column.&nbsp;
When there are successful (<FONT COLOR="#00FF00">green</FONT>) builds in
all the columns in a row <B>above</B> your name, you know you are ok.</FONT>
<BR>
<BR><B><FONT SIZE=+2>Q. The tree is broken, how do I find out what is busted
(or who busted it).</FONT></B>
<BR><FONT SIZE=+2>A. Clicking 'L' in the first red box (first build to break)
above a green will show you a build log for the broken build.&nbsp; You
can also click 'C' in this box and see what code was checked in.</FONT>
<BR>
<BR><B><FONT SIZE=+2>More Questions? Mail me <A HREF="mailto:ltabb@netscape.com">ltabb@netscape.com</A></FONT></B>
<BR>
</BODY>
</HTML>

217
webtools/tinderbox/fixupimages.pl Executable file
Просмотреть файл

@ -0,0 +1,217 @@
#!/usr/bonsaitools/bin/perl --
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Tinderbox build tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
use Socket;
require 'globals.pl';
require 'imagelog.pl';
# Port an old-style imagelog thing to a newstyle one
open( IMAGELOG, "<$data_dir/imagelog.txt" ) || die "can't open file";
open (OUT, ">$data_dir/newimagelog.txt") || die "can't open output file";
select(OUT); $| = 1; select(STDOUT);
while( <IMAGELOG> ){
chop;
($url,$quote) = split(/\`/);
print "$url\n";
$size = &URLsize($url);
$width = "";
$height = "";
if ($size =~ /WIDTH=([0-9]*)/) {
$width = $1;
}
if ($size =~ /HEIGHT=([0-9]*)/) {
$height = $1;
}
if ($width eq "" || $height eq "") {
print "Couldn't get image size; skipping.\n";
} else {
print OUT "$url`$width`$height`$quote\n";
}
}
sub imgsize {
local($file)= @_;
#first try to open the file
if( !open(STREAM, "<$file") ){
print "Can't open IMG $file";
$size="";
} else {
if ($file =~ /.jpg/i || $file =~ /.jpeg/i) {
$size = &jpegsize(STREAM);
} elsif($file =~ /.gif/i) {
$size = &gifsize(STREAM);
} elsif($file =~ /.xbm/i) {
$size = &xbmsize(STREAM);
} else {
return "";
}
$_ = $size;
if( /\s*width\s*=\s*([0-9]*)\s*/i ){
($newwidth)= /\s*width\s*=\s*(\d*)\s*/i;
}
if( /\s*height\s*=\s*([0-9]*)\s*/i ){
($newheight)=/\s*height\s*=\s*(\d*)\s*/i;
}
close(STREAM);
}
return $size;
}
###########################################################################
# Subroutine gets the size of the specified GIF
###########################################################################
sub gifsize {
local($GIF) = @_;
read($GIF, $type, 6);
if(!($type =~ /GIF8[7,9]a/) ||
!(read($GIF, $s, 4) == 4) ){
print "Invalid or Corrupted GIF";
$size="";
} else {
($a,$b,$c,$d)=unpack("C"x4,$s);
$size=join ("", 'WIDTH=', $b<<8|$a, ' HEIGHT=', $d<<8|$c);
}
return $size;
}
sub xbmsize {
local($XBM) = @_;
local($input)="";
$input .= <$XBM>;
$input .= <$XBM>;
$_ = $input;
if( /#define\s*\S*\s*\d*\s*\n#define\s*\S*\s*\d*\s*\n/i ){
($a,$b)=/#define\s*\S*\s*(\d*)\s*\n#define\s*\S*\s*(\d*)\s*\n/i;
$size=join ("", 'WIDTH=', $a, ' HEIGHT=', $b );
} else {
print "Hmmm... Doesn't look like an XBM file";
}
return $size;
}
# jpegsize : gets the width and height (in pixels) of a jpeg file
# Andrew Tong, werdna@ugcs.caltech.edu February 14, 1995
# modified slightly by alex@ed.ac.uk
sub jpegsize {
local($JPEG) = @_;
local($done)=0;
$size="";
read($JPEG, $c1, 1); read($JPEG, $c2, 1);
if( !((ord($c1) == 0xFF) && (ord($c2) == 0xD8))){
printf "This is not a JPEG! (Codes %02X %02X)\n", ord($c1), ord($c2);
$done=1;
}
while (ord($ch) != 0xDA && !$done) {
# Find next marker (JPEG markers begin with 0xFF)
# This can hang the program!!
while (ord($ch) != 0xFF) { read($JPEG, $ch, 1); }
# JPEG markers can be padded with unlimited 0xFF's
while (ord($ch) == 0xFF) { read($JPEG, $ch, 1); }
# Now, $ch contains the value of the marker.
$marker=ord($ch);
if (($marker >= 0xC0) && ($marker <= 0xCF) &&
($marker != 0xC4) && ($marker != 0xCC)) { # it's a SOFn marker
read ($JPEG, $junk, 3); read($JPEG, $s, 4);
($a,$b,$c,$d)=unpack("C"x4,$s);
$size=join("", 'HEIGHT=',$a<<8|$b,' WIDTH=',$c<<8|$d );
$done=1;
} else {
# We **MUST** skip variables, since FF's within variable
# names are NOT valid JPEG markers
read ($JPEG, $s, 2);
($c1, $c2) = unpack("C"x2,$s);
$length = $c1<<8|$c2;
if( ($length < 2) ){
print "Erroneous JPEG marker length";
$done=1;
} else {
read($JPEG, $junk, $length-2);
}
}
}
return $size;
}
###########################################################################
# Subroutine grabs a gif from another server and gets its size
###########################################################################
sub URLsize {
my ($fullurl) = @_;
my($dummy, $dummy, $serverstring, $url) = split(/\//, $fullurl, 4);
my($them,$port) = split(/:/, $serverstring);
my $port = 80 unless $port;
$them = 'localhost' unless $them;
my $size="";
$_=$url;
if( /gif/i || /jpeg/i || /jpg/i || /xbm/i ) {
my ($remote, $iaddr, $paddr, $proto, $line);
$remote = $them;
if ($port =~ /\D/) { $port = getservbyname($port, 'tcp') }
die "No port" unless $port;
$iaddr = inet_aton($remote) || die "no host: $remote";
$paddr = sockaddr_in($port, $iaddr);
$proto = getprotobyname('tcp');
socket(S, PF_INET, SOCK_STREAM, $proto) || return "socket: $!";
connect(S, $paddr) || return "connect: $!";
select(S); $| = 1; select(STDOUT);
print S "GET /$url\n";
if ($url =~ /.jpg/i || $url =~ /.jpeg/i) {
$size = &jpegsize(S);
} elsif($url =~ /.gif/i) {
$size = &gifsize(S);
} elsif($url =~ /.xbm/i) {
$size = &xbmsize(S);
} else {
return "";
}
$_ = $size;
if( /\s*width\s*=\s*([0-9]*)\s*/i ){
($newwidth)= /\s*width\s*=\s*(\d*)\s*/i;
}
if( /\s*height\s*=\s*([0-9]*)\s*/i ){
($newheight)=/\s*height\s*=\s*(\d*)\s*/i;
}
} else {
$size="";
}
return $size;
}
sub dokill {
kill 9,$child if $child;
}

488
webtools/tinderbox/globals.pl Executable file
Просмотреть файл

@ -0,0 +1,488 @@
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Tinderbox build tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
#
# Global variabls and functions for tinderbox
#
#
# Global variables
#
$td1 = {};
$td2 = {};
$build_list = []; # array of all build records
$build_name_index = {};
$build_name_names = [];
$name_count = 0;
$build_time_index = {};
$build_time_times = [];
$time_count = 0;
$build_table = [];
$who_list = [];
$who_list2 = [];
@note_array = ();
#$body_tag = "<BODY TEXT=#000000 BGCOLOR=#8080C0 LINK=#FFFFFF VLINK=#800080 ALINK=#FFFF00>";
#$body_tag = "<BODY TEXT=#000000 BGCOLOR=#FFFFC0 LINK=#0000FF VLINK=#800080 ALINK=#FF00FF>";
if( $ENV{'USERNAME'} eq 'ltabb' ){
$gzip = 'gzip';
}
else {
$gzip = '/usr/local/bin/gzip';
}
$data_dir='data';
$lock_count = 0;
1;
sub lock{
#if( $lock_count == 0 ){
# print "locking $tree/LOCKFILE.lck\n";
# open( LOCKFILE_LOCK, ">$tree/LOCKFILE.lck" );
# flock( LOCKFILE_LOCK, 2 );
#}
#$lock_count++;
}
sub unlock{
#$lock_count--;
#if( $lock_count == 0 ){
# flock( LOCKFILE_LOCK, 8 );
# close( LOCKFILE_LOCK );
#}
}
sub print_time {
local($t) = @_;
local($sec,$minute,$hour,$mday,$mon,$year);
($sec,$minute,$hour,$mday,$mon,$year) = localtime( $t );
sprintf("%02d/%02d&nbsp;%02d:%02d",$mon+1,$mday,$hour,$minute);
}
sub url_encode {
local( $s ) = @_;
$s =~ s/\%/\%25/g;
$s =~ s/\=/\%3d/g;
$s =~ s/\?/\%3f/g;
$s =~ s/ /\%20/g;
$s =~ s/\n/\%0a/g;
$s =~ s/\r//g;
$s =~ s/\"/\%22/g;
$s =~ s/\'/\%27/g;
$s =~ s/\|/\%7c/g;
$s =~ s/\&/\%26/g;
return $s;
}
sub url_decode {
local($value) = @_;
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
return $value;
}
sub value_encode {
my($s) = @_;
$s =~ s@&@&amp;@g;
$s =~ s@<@&lt;@g;
$s =~ s@>@&gt;@g;
$s =~ s@\"@&quot;@g;
return $s;
}
sub load_data {
$tree2 = $form{'tree2'};
if( $tree2 ne '' ){
require "$tree2/treedata.pl";
$td2 = {};
$td2->{name} = $tree2;
$td2->{cvs_module} = $cvs_module;
$td2->{cvs_branch} = $cvs_branch;
$td2->{num} = 1;
if( $cvs_root eq '' ){
$cvs_root = '/m/src';
}
$td2->{cvs_root} = $cvs_root;
$tree = $form{'tree'};
require "$tree/treedata.pl";
if( $cvs_root eq '' ){
$cvs_root = '/m/src';
}
}
$tree = $form{'tree'};
die "the \"tree\" parameter must be provided\n" unless $tree;
require "$tree/treedata.pl";
$td1 = {};
$td1->{name} = $tree;
$td1->{num} = 0;
$td1->{cvs_module} = $cvs_module;
$td1->{cvs_branch} = $cvs_branch;
if( $cvs_root eq '' ){
$cvs_root = '/m/src';
}
$td1->{cvs_root} = $cvs_root;
&lock;
&load_buildlog;
&unlock;
&get_build_name_index;
&get_build_time_index;
&load_who($who_list, $td1);
if( $tree2 ne "" ){
&load_who($who_list2, $td2);
}
&make_build_table;
}
sub load_buildlog {
local($mailtime, $buildtime, $buildname, $errorparser, $buildstatus, $logfile,$binaryname);
local($buildrec, @treelist, $t);
if( $tree2 ne '' ){
@treelist = ($td1, $td2);
}
else {
@treelist = ($td1);
}
for $t (@treelist) {
open(BUILDLOG, "<$t->{name}/build.dat" );
while( <BUILDLOG> ){
chop;
($mailtime, $buildtime, $buildname, $errorparser, $buildstatus, $logfile, $binaryname) =
split( /\|/ );
$buildrec = {
mailtime => $mailtime,
buildtime => $buildtime,
buildname => ($tree2 ne "" ? $t->{name} . " " : "" ) . $buildname,
errorparser => $errorparser,
buildstatus => $buildstatus,
logfile => $logfile,
binaryname => $binaryname,
td => $t
};
if( $mailtime > 0 && $buildtime > $mindate ){
push @{$build_list}, $buildrec;
}
}
close( BUILDLOG );
}
}
sub load_who {
local( $who_list, $td ) = @_;
local($d,$w,$i,$bfound);
open(WHOLOG, "<$td->{name}/who.dat" );
while( <WHOLOG> ){
$i = $time_count;
chop;
($d,$w) = split(/\|/);
$bfound = 0;
while( $i > 0 && !$bfound ){
if( $d <= $build_time_times->[$i] ){
$who_list->[$i+1]->{$w} = 1;
$bfound = 1;
}
else {
$i--;
}
}
}
#
# Ignore the last one
#
if( $time_count > 0 ){
$who_list->[$time_count] = {};
}
}
sub get_build_name_index {
local($i,$br);
#
# Get all the unique build names.
#
for $br (@{$build_list}) {
$build_name_index->{$br->{buildname}} = 1;
}
$i = 1;
for $n (sort keys (%{$build_name_index})) {
$build_name_names->[$i] = $n;
$i++;
}
$name_count = @{$build_name_names}-1;
#
# update the map so it points to the right index
#
$i = 1;
while( $i < $name_count+1 ){
$build_name_index->{$build_name_names->[$i]} = $i;
#print "$name_count $build_name_names->[$i] $i <br>\n";
$i++;
}
#for $i (@{$build_name_names}) {
# print "$build_name_names->[$i] $i <br>\n";
#&}
}
sub get_build_time_index {
local($i,$br);
#
# Get all the unique build names.
#
for $br (@{$build_list}) {
$build_time_index->{$br->{buildtime}} = 1;
#$build_time_index->{$br->{mailtime}} = 1;
}
$i = 1;
for $n (sort {$b <=> $a} keys (%{$build_time_index})) {
$build_time_times->[$i] = $n;
$i++;
}
$time_count = @{$build_time_times}-1;
#
# update the map so it points to the right index
#
$i = 1;
while( $i < $time_count+1 ){
$build_time_index->{$build_time_times->[$i]} = $i;
$i++;
}
#for $i (@{$build_time_times}) {
# print $i . "\n";
#}
#while( ($k,$v) = each(%{$build_time_index})) {
# print "$k=$v\n";
#}
}
sub make_build_table {
local($i,$ti,$bi,$ti1,$br);
$i = 1;
#
# Create the build table
#
while( $i <= $time_count ){
$build_table->[$i] = [];
$i++;
}
#
# Populate the build table with build data
#
for $br (@{$build_list}) {
$ti = $build_time_index->{$br->{buildtime}};
$bi = $build_name_index->{$br->{buildname}};
$build_table->[$ti][$bi] = $br;
}
&load_notes;
$bi = $name_count;
while( $bi > 0 ){
$ti = $time_count;
while( $ti > 0 ){
if( defined( $br = $build_table->[$ti][$bi] )
&& !defined( $br->{rowspan} )
){
#
# If the cell immediatley after us is defined, then we
# can have a previousbuildtime.
#
if( defined( $br1 = $build_table->[$ti+1][$bi] )){
$br->{previousbuildtime} = $br1->{buildtime};
}
$ti1 = $ti-1;
while( $ti1 > 0
&& !defined( $build_table->[$ti1][$bi] )
#&& $build_time_times->[$ti1] < $br->{mailtime}
){
$build_table->[$ti1][$bi] = -1;
$ti1--;
}
$br->{rowspan} = $ti - $ti1;
if( $br->{rowspan} != 1 ){
$build_table->[$ti1+1][$bi] = $br;
$build_table->[$ti][$bi] = -1;
}
};
$ti--;
}
$bi--;
}
}
sub load_notes {
if( $tree2 ne '' ){
@treelist = ($td1, $td2);
}
else {
@treelist = ($td1);
}
for $t (@treelist) {
open(NOTES,"<$t->{name}/notes.txt") || print "<h2>warning: Couldn't open $t->{name}/notes.txt </h2>\n";
while(<NOTES>){
chop;
($nbuildtime,$nbuildname,$nwho,$nnow,$nenc_note) = split(/\|/);
if( $tree2 ne "" ) { $nbuildname = $t->{name} . " " . $nbuildname; }
$ti = $build_time_index->{$nbuildtime};
$bi = $build_name_index->{$nbuildname};
#print "[ti = $ti][bi=$bi][buildname='$nbuildname' $_<br>";
if( $ti != 0 && $bi != 0 ){
$build_table->[$ti][$bi]->{hasnote} = 1;
if( ! defined($build_table->[$ti][$bi]->{noteid}) ){
$build_table->[$ti][$bi]->{noteid} = (0+@note_array);
}
$noteid = $build_table->[$ti][$bi]->{noteid};
$now_str = &print_time($nnow);
$note = &url_decode($nenc_note);
$note_array[$noteid] .=
"<pre>\n[<b><a href=mailto:$nwho>$nwho</a> - $now_str</b>]\n$note\n</pre>";
}
}
close(NOTES);
}
}
sub last_good_time {
local($row) = @_;
local($t,$currently_busted);
$t = 1;
$isbusted = 0;
while( $t <= $time_count ){
if( defined( $build_table->[$t][$row] )){
if( $build_table->[$t][$row]->{buildstatus} eq 'success' ){
return {
buildtime =>
$build_time_times->[ $t +
$build_table->[$t][$row]->{rowspan} ],
isbusted => $isbusted };
}
elsif( $build_table->[$t][$row]->{buildstatus} eq 'busted' ){
$isbusted = 1;
}
else {
}
}
$t++;
}
return {buildtime => 0, isbusted => 1};
}
sub check_password {
if ($form{'password'} eq "") {
if (defined $cookie_jar{'tinderbox_password'}) {
$form{'password'} = $cookie_jar{'tinderbox_password'};
}
}
my $correct = "";
if (open(REAL, "<data/passwd")) {
$correct = <REAL>;
close REAL;
$correct =~ s/\s+$//; # Strip trailing whitespace.
}
if ($correct eq "") {
return;
}
$form{'password'} =~ s/\s+$//; # Strip trailing whitespace.
if ($form{'password'} ne "") {
open(TRAPDOOR, "../bonsai/data/trapdoor $form{'password'} |") || die "Can't run trapdoor func!";
my $encoded = <TRAPDOOR>;
close TRAPDOOR;
$encoded =~ s/\s+$//; # Strip trailing whitespace.
if ($encoded eq $correct) {
if ($form{'rememberpassword'} ne "") {
print "Set-Cookie: tinderbox_password=$form{'password'} ; path=/ ; expires = Sun, 1-Mar-2020 00:00:00 GMT\n";
}
return;
}
}
require 'header.pl';
print "Content-type: text/html\n";
print "Set-Cookie: tinderbox_password= ; path=/ ; expires = Sun, 1-Mar-2020 00:00:00 GMT\n";
print "\n";
EmitHtmlHeader("What's the magic word?",
"You need to know the magic word to use this page.");
if ($form{'password'} ne "") {
print "<B>Invalid password; try again.<BR></B>";
}
print "
<FORM method=post>
<B>Password:</B>
<INPUT NAME=password TYPE=password><BR>
<INPUT NAME=rememberpassword TYPE=checkbox> If correct, remember password as a cookie<BR>
";
while (my ($key,$value) = each %form) {
if ($key eq "password" || $key eq "rememberpassword") {
next;
}
my $enc = value_encode($value);
print "<INPUT TYPE=HIDDEN NAME=$key VALUE=\"$enc\">\n";
}
print "<INPUT TYPE=SUBMIT value=Submit></FORM>\n";
exit;
}

44
webtools/tinderbox/handlemail.pl Executable file
Просмотреть файл

@ -0,0 +1,44 @@
#!/usr/bonsaitools/bin/perl --
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Tinderbox build tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
# Figure out which directory tinderbox is in by looking at argv[0]
$tinderboxdir = $0;
$tinderboxdir =~ s:/[^/]*$::; # Remove last word, and slash before it.
if ($tinderboxdir eq "") {
$tinderboxdir = ".";
}
print "tinderbox = $tinderboxdir\n";
chdir $tinderboxdir || die "Couldn't chdir to $tinderboxdir";
open(DF, ">data/tbx.$$") || die "could not open data/tbx.$$";
while(<STDIN>){
print DF $_;
}
close(DF);
$err = system("./processbuild.pl data/tbx.$$");
if( $err ) {
die "processbuild.pl returned an error\n";
}

43
webtools/tinderbox/imagelog.pl Executable file
Просмотреть файл

@ -0,0 +1,43 @@
#!/usr/bonsaitools/bin/perl --
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Tinderbox build tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
1;
sub add_imagelog {
local($url,$quote,$width,$height) = @_;
open( IMAGELOG, ">>$data_dir/imagelog.txt" ) || die "Oops; can't open imagelog.txt";
print IMAGELOG "$url`$width`$height`$quote\n";
close( IMAGELOG );
}
sub get_image{
local(@log,@ret,$i);
open( IMAGELOG, "<$data_dir/imagelog.txt" );
@log = <IMAGELOG>;
# return a random line
srand;
@ret = split(/\`/,$log[rand @log]);
close( IMAGELOG );
@ret;
}

12
webtools/tinderbox/index.html Executable file
Просмотреть файл

@ -0,0 +1,12 @@
<TITLE>tinderbox</TITLE>
<META HTTP-EQUIV="Refresh" CONTENT="1; URL=showbuilds.cgi">
<BODY BGCOLOR="#FFFFFF" TEXT="#000000"
LINK="#0000EE" VLINK="#551A8B" ALINK="#FF0000">
<CENTER>
<TABLE BORDER=0 WIDTH="100%" HEIGHT="100%"><TR><TD ALIGN=CENTER VALIGN=CENTER>
<FONT SIZE="+2">
You're looking for
<A HREF="showbuilds.cgi">showbuilds.cgi</A>.
</FONT>
</TD></TR></TABLE>
</CENTER>

214
webtools/tinderbox/processbuild.pl Executable file
Просмотреть файл

@ -0,0 +1,214 @@
#!/usr/bonsaitools/bin/perl --
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Tinderbox build tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
require 'globals.pl';
require 'timelocal.pl';
umask 0;
%MAIL_HEADER = ();
%tbx = ();
$logfile = '';
&get_variables;
&check_required_vars;
&compress_log_file;
&unlink_log_file;
$tree = $tbx{'tree'};
&lock;
&write_build_data;
&unlock;
$err = system("./buildwho.pl $tbx{'tree'}");
#
# This routine will scan through log looking for 'tinderbox:' variables
#
sub get_variables{
open( LOG, "<$ARGV[0]") || die "cant open $!";
&parse_mail_header;
#while( ($k,$v) = each( %MAIL_HEADER ) ){
# print "$k='$v'\n";
#}
&parse_log_variables;
#while( ($k,$v) = each( %tbx ) ){
# print "$k='$v'\n";
#}
close(LOG);
}
sub parse_log_variables {
while($line = <LOG> ){
chop($line);
if( $line =~ /^tinderbox\:/ ){
if( $line =~ /^tinderbox\:[ \t]*([^:]*)\:[ \t]*([^\n]*)/ ){
$tbx{$1} = $2;
}
}
}
}
sub parse_mail_header {
while($line = <LOG> ){
chop($line);
if( $line eq '' ){
return;
}
if( $line =~ /([^ :]*)\:[ \t]+([^\n]*)/ ){
$name = $1;
$MAIL_HEADER{$name} = $2;
#print "$name $2\n";
}
elsif( $name ne '' ){
$MAIL_HEADER{$name} .= $2;
}
}
}
sub check_required_vars {
$err_string = '';
if( $tbx{'tree'} eq ''){
$err_string .= "Variable 'tinderbox:tree' not set.\n";
}
elsif( ! -r $tbx{'tree'} ){
$err_string .= "Variable 'tinderbox:tree' not set to a valid tree.\n";
}
if( $tbx{'build'} eq ''){
$err_string .= "Variable 'tinderbox:build' not set.\n";
}
if( $tbx{'errorparser'} eq ''){
$err_string .= "Variable 'tinderbox:errorparser' not set.\n";
}
#
# Grab the date in the form of mm/dd/yy hh:mm:ss
#
# Or a GMT unix date
#
if( $tbx{'builddate'} eq ''){
$err_string .= "Variable 'tinderbox:builddate' not set.\n";
}
else {
if( $tbx{'builddate'} =~
/([0-9]*)\/([0-9]*)\/([0-9]*)[ \t]*([0-9]*)\:([0-9]*)\:([0-9]*)/ ){
$builddate = timelocal($6,$5,$4,$2,$1-1,$3);
}
elsif( $tbx{'builddate'} > 7000000 ){
$builddate = $tbx{'builddate'};
}
else {
$err_string .= "Variable 'tinderbox:builddate' not of the form MM/DD/YY HH:MM:SS or unix date\n";
}
}
#
# Build Status
#
if( $tbx{'status'} eq ''){
$err_string .= "Variable 'tinderbox:status' not set.\n";
}
elsif( ! $tbx{'status'} =~ /success|busted|building/ ){
$err_string .= "Variable 'tinderbox:status' must be 'success', 'busted' or 'building'\n";
}
#
# Report errors
#
if( $err_string ne '' ){
die $err_string;
}
}
sub write_build_data {
$t = time;
open( BUILDDATA, ">>$tbx{'tree'}/build.dat" )|| die "can't open $! for writing";
print BUILDDATA "$t|$builddate|$tbx{'build'}|$tbx{'errorparser'}|$tbx{'status'}|$logfile|$tbx{binaryname}\n";
close( BUILDDATA );
}
sub compress_log_file {
local( $done, $line);
if( $tbx{'status'} =~ /building/ ){
return;
}
open( LOG2, "<$ARGV[0]") || die "cant open $!";
#
# Skip past the the RFC822.HEADER
#
$done = 0;
while( !$done && ($line = <LOG2>) ){
chop($line);
$done = ($line eq '');
}
$logfile = "$$.gz";
open( ZIPLOG, "| $gzip -c > $tbx{'tree'}/$logfile" ) || die "can't open $! for writing";
$inBinary = 0;
$hasBinary = ($tbx{'binaryname'} ne '');
while( $line = <LOG2> ){
if( !$inBinary ){
print ZIPLOG $line;
if( $hasBinary ){
$inBinary = ($line =~ /^begin [0-7][0-7][0-7] /);
}
}
else {
if( $line =~ /^end\n/ ){
$inBinary = 0;
}
}
}
close( ZIPLOG );
close( LOG2 );
#
# If a uuencoded binary is part of the build, unpack it.
#
if( $hasBinary ){
$bin_dir = "$tbx{'tree'}/bin/$builddate/$tbx{'build'}";
$bin_dir =~ s/ //g;
system("mkdir -m 0777 -p $bin_dir");
# LTNOTE: I'm not sure this is cross platform.
system("/tools/ns/bin/uudecode --output-file=$bin_dir/$tbx{binaryname} < $ARGV[0]");
}
}
sub unlink_log_file {
unlink( $ARGV[0] );
}

0
webtools/tinderbox/reledanim.gif Normal file
Просмотреть файл

552
webtools/tinderbox/showbuilds.cgi Executable file
Просмотреть файл

@ -0,0 +1,552 @@
#!/usr/bonsaitools/bin/perl --
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Tinderbox build tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
use lib "../bonsai";
require 'globals.pl';
require 'lloydcgi.pl';
require 'imagelog.pl';
require 'header.pl';
$|=1;
print "Content-type: text/html\n\n<HTML>\n";
#
# show 36 hours by default
#
if($form{'showall'} != 0 ){
$mindate = 0;
}
else {
$hours = 36;
if( $form{hours} ne "" ){
$hours = $form{hours};
}
$mindate = time - ($hours*60*60);
}
$colormap = {
success => '00ff00',
busted => 'red',
building => 'yellow'
};
#
# Debug hack
#
#$form{'tree'} = DogbertTip;
$tree = $form{'tree'};
if( $form{'tree'} eq '' ){
&show_tree_selector;
}
else {
if( $form{'express'} ) {
&do_express;
}
else {
&load_data;
&load_javascript;
&display_page_head;
&display_build_table;
}
}
sub show_tree_selector {
EmitHtmlHeader("tinderbox");
print "<P><TABLE WIDTH=\"100%\">";
print "<TR><TD ALIGN=CENTER>Select one of the following trees:</TD></TR>";
print "<TR><TD ALIGN=CENTER>\n";
print " <TABLE><TR><TD><UL>\n";
while(<*>) {
if( -d $_ && $_ ne 'data' && $_ ne 'CVS' ){
print "<LI><a href=showbuilds.cgi?tree=$_>$_</a>\n";
}
}
print "<//UL></TD></TR></TABLE></TD></TR></TABLE>";
}
sub display_page_head {
my ($imageurl,$imagewidth,$imageheight,$quote) = &get_image;
# srand;
# $when = 60*10 + int rand(60*40);
# <META HTTP-EQUIV=\"REFRESH\" CONTENT=\"$when\">
if( -r "$tree/mod.pl" ){
require "$tree/mod.pl";
}
else {
$message_of_day = "";
}
$treename = $tree . ($tree2 ne "" ? " and $tree2" : "" );
EmitHtmlTitleAndHeader("tinderbox: $treename", "tinderbox",
"tree: $treename");
print "$script_str\n";
print "$message_of_day\n";
print "<table width='100%'>";
print "<tr>";
print "<td valign=bottom>";
print "<p><center><a href=addimage.cgi><img src='$imageurl' ";
print "width=$imagewidth height=$imageheight><br>";
print "$quote</a><br>";
print "</center>";
print "<p>";
print "<td align=right valign=bottom>";
print "<table><tr><td>";
print "<TT>L</TT> = Show Build Log<br>";
print "<TT><img src=star.gif>L</TT> = Show Log comments<br>";
print "<TT>C</TT> = Show changes that occured since the last build<br>";
print "<TT>B</TT> = Download binary generated by the build<br>";
print "<table cellspacing=2 border>";
print "<tr bgcolor=yellow><td>Currently Building";
print "<tr bgcolor=00ff00><td>Built successfully";
print "<tr bgcolor=red><td>Build failed";
print "</table>";
print "</td></tr></table>";
print "</table>";
if( $form{'tree'} eq 'MercuryTip' || $form{'tree'} eq 'FreeSource'){
print "<p>The tree is currently <font size=+2>";
if( &tree_open ){
print "OPEN";
}
else {
print "CLOSED";
}
print "</font>\n";
}
}
sub display_build_table {
&display_build_table_header;
&display_build_table_body;
&display_build_table_footer;
}
sub display_build_table_body {
local($t);
$t = 1;
while( $t <= $time_count ){
display_build_table_row( $t );
$t++;
}
}
sub display_build_table_row {
local($t) = @_;
local($tt);
$tt = &print_time($build_time_times->[$t]);
if( $tree2 ne "" ){
$qr = "";
$er = "";
}
else {
$qr = &query_ref( $td1, $build_time_times->[$t]);
$er = "</a>";
}
if ($build_time_times->[$t] % 7200 > 3600) {
$color = "white";
} else {
$color = "beige";
}
print "<tr align=center>\n";
print "<td bgcolor=$color>${qr}\n${tt}${er}\n";
if( $tree2 ne "" ){
print "<td align=center bgcolor=beige>\n";
$qr = &query_ref( $td1, $build_time_times->[$t]);
print "${qr}<tt><b>X</b></tt></a>\n";
}
print "<td align=center>\n";
for $who (sort keys %{$who_list->[$t]} ){
#$qr = &query_ref( $td1, $build_time_times->[$t],$build_time_times->[$t-1],$who);
$qr = &who_menu( $td1, $build_time_times->[$t],$build_time_times->[$t-1],$who);
print " ${qr}$who</a>\n";
}
if( $tree2 ne "" ){
print "<td align=cenger bgcolor=beige >\n";
$qr = &query_ref( $td2, $build_time_times->[$t]);
print "${qr}<tt><b>X</b></tt></a>\n";
print "<td align=center>\n";
for $who (sort keys %{$who_list2->[$t]} ){
#$qr = &query_ref( $td2, $build_time_times->[$t],$build_time_times->[$t-1],$who);
$qr = &who_menu( $td2, $build_time_times->[$t],$build_time_times->[$t-1],$who);
print " ${qr}$who</a>\n";
}
}
$bn = 1;
while( $bn <= $name_count ){
if( defined($br = $build_table->[$t][$bn])){
if( $br != -1 ){
$hasnote = $br->{hasnote};
$noteid = $hasnote ? $br->{noteid} : 0;
$rowspan = $br->{rowspan};
$color = $colormap->{$br->{buildstatus}};
$status = $br->{buildstatus};
print "<td rowspan=$rowspan bgcolor=${color}>\n";
$logfile = $br->{logfile};
$errorparser = $br->{errorparser};
$buildname = $br->{buildname};
if( $tree2 ne "" ){
$buildname =~ s/^[^ ]* //;
}
$buildname = &url_encode($buildname);
$buildtime = $br->{buildtime};
$buildtree = $br->{td}->{name};
print "<tt>\n";
if( $hasnote ){
print "<a href='' onClick=\"return js_what_menu(event,$noteid,'$logfile','$errorparser','$buildname','$buildtime');\">";
print "<img src=star.gif border=0></a>\n";
}
print "<a href='showlog.cgi?logfile=$logfile\&tree=$buildtree\&errorparser=$errorparser&buildname=$buildname&buildtime=$buildtime&mainframe=1'>\n";
print "L</a>\n";
#print "Build Summary</a><br>\n";
if( $br->{previousbuildtime} ){
$qr = &query_ref($br->{td}, $br->{previousbuildtime},$br->{buildtime});
print "$qr\n";
print " C</a>\n";
#print "What Changed</a><br>\n";
}
if( $br->{binaryname} ne '' ){
$binfile = "$buildtree/bin/$buildtime/$br->{buildname}/$br->{binaryname}";
$binfile =~ s/ //g;
print " <a href=$binfile>B</a>";
}
print "</tt>\n";
}
}
else {
print "<td>&nbsp;\n";
}
$bn++;
}
print "</tr>\n";
}
sub display_build_table_header {
local($i,$nspan);
print "<TABLE border cellspacing=2>\n";
print "<tr align=center>\n";
print "<td rowspan=1><font size=-1>Click time to <br>see changes <br>since time</font>";
$nspan = ( $tree2 ne "" ? 4 : 1);
print "<td colspan=$nspan><font size=-1>Click name to see what they did</font>";
#print "<td colspan=$name_count><font size=-1>Burning builds are busted</font>";
#print "</tr>\n";
#print "<tr>\n";
$i = 1;
while ($i <= $name_count){
$bn = $build_name_names->[$i];
$bn =~ s/Clobber/Clbr/g;
$bn =~ s/Depend/Dep/g;
$t = &last_good_time($i);
if( $form{'narrow'} ){
$bn =~ s/([^:])/$1<br>/g;
$bn = "<tt>$bn</tt>";
}
else {
$bn = "<font face='Arial,Helvetica' size=-2>$bn</font>";
}
if( $t->{isbusted} ){
print "<td rowspan=2 bgcolor=000000 background=1afi003r.gif>";
print "<font color=white>$bn</font>\n";
#print "<img src=reledanim.gif>\n";
}
else {
print "<th rowspan=2 bgcolor=00ff00>";
print "$bn\n";
}
$i++;
}
print "</tr>\n";
print "<tr>\n";
print "<b><TH>Build Time\n";
if( $tree2 ne "" ){
print "<TH colspan=2>$td1->{name}\n";
print "<TH colspan=2>$td2->{name}\n";
}
else {
print "<TH>Guilty\n";
}
print "</b></tr>\n";
}
sub display_build_table_footer {
print "</table>\n";
print "<a href=showbuilds.cgi?tree=$tree&showall=1.cgi>Show more checkin history</a><br><br>\n";
if (open(FOOTER, "<$data_dir/footer.html")) {
while (<FOOTER>) {
print $_;
}
close FOOTER;
}
print "<a href=admintree.cgi?tree=$tree>Administrate Tinderbox Trees</a><br>";
print "<br><br>";
}
sub query_ref {
local( $td, $mindate, $maxdate, $who ) = @_;
return "<a href=../bonsai/cvsquery.cgi?module=$td->{cvs_module}&branch=$td->{cvs_branch}&cvsroot=$td->{cvs_root}&date=explicit&mindate=$mindate&maxdate=$maxdate&who=$who>";
}
sub query_ref2 {
local( $td, $mindate, $maxdate, $who ) = @_;
return "../bonsai/cvsquery.cgi?module=$td->{cvs_module}&branch=$td->{cvs_branch}&cvsroot=$td->{cvs_root}&date=explicit&mindate=$mindate&maxdate=$maxdate&who=$who";
}
sub who_menu {
local( $td, $mindate, $maxdate, $who ) = @_;
my $treeflag;
#$qr="../bonsai/cvsquery.cgi?module=$td->{cvs_module}&branch=$td->{cvs_branch}&cvsroot=$td->{cvs_root}&date=explicit&mindate=$mindate&maxdate=$maxdate&who=$who";
$qr = "../registry/who.cgi?email=$who"
. "&t0=" . &url_encode("What did $who check into the source tree" )
. "&u0=" . &url_encode( &query_ref2($td,$mindate,$maxdate,$who) )
. "&t1=" . &url_encode("What has $who been checking in in the last day" )
. "&u1=" . &url_encode( &query_ref2($td,$mindate,$maxdate,$who) );
return "<a href='$qr' onClick=\"return js_who_menu($td->{num},'$who',event,$mindate,$maxdate);\" >";
}
sub tree_open {
open( BID, "<../bonsai/data/batchid") || print "can't open batchid<br>";
($a,$b,$bid) = split(/ /,<BID>);
close( BID );
open( BATCH, "<../bonsai/data/batch-${bid}") || print "can't open batch-${bid}<br>";;
$done = 0;
while( ($line = <BATCH>) && !$done ){
if($line =~ /^set treeopen/) {
chop( $line );
($a,$b,$treestate) = split(/ /, $line );
$done = 1;
}
}
close( BATCH );
return $treestate;
}
sub load_javascript {
$script_str =<<'ENDJS';
<script>
if( parseInt(navigator.appVersion) < 4 ){
window.event = 0;
}
function js_who_menu(tree,n,d,mindate,maxdate) {
if( parseInt(navigator.appVersion) < 4 ){
return true;
}
l = document.layers['popup'];
l.src = "../registry/who.cgi?email=" + n
+ "&t0=" + escape("Last check-in" )
+ "&u0=" + escape( js_qr(tree,mindate,maxdate,n) )
+ "&t1=" + escape("Check-ins within 24 hours" )
+ "&u1=" + escape( js_qr24(tree,n) );
//l.document.write(
// "<table border=1 cellspacing=1><tr><td>" +
// js_qr(mindate,maxdate,n) + "What did " + n + " <b>check in to the source tree</b>?</a><br>" +
// js_qr24(n) +"What has " + n + " <b>been checking in over the last day</b>?</a> <br>" +
// "<a href=https://endor.mcom.com/ds/dosearch/endor.mcom.com/uid%3D" +n + "%2Cou%3DPeople%2Co%3DNetscape%20Communications%20Corp.%2Cc%3DUS>" +
// "Who is <b>" + n + "</b> and how do <b>I wake him/her up</b></a>?<br>" +
// "<a href='mailto:" + n + "?subject=Whats up with...'>Send mail to <b>" + n + "</b></a><br>" +
// "<a href=http://dome/locator/findUser.cgi?email="+n+">Where is <b>"+n+"'s office?</b></a>" +
// "</tr></table>");
//l.document.close();
//alert( d.y );
l.top = d.target.y - 6;
l.left = d.target.x - 6;
if( l.left + l.clipWidth > window.width ){
l.left = window.width - l.clipWidth;
}
l.visibility="show";
return false;
}
function js_what_menu(d,noteid,logfile,errorparser,buildname,buildtime) {
if( parseInt(navigator.appVersion) < 4 ){
return true;
}
l = document.layers['popup'];
l.document.write(
"<table border=1 cellspacing=1><tr><td>" +
note_array[noteid] +
"</tr></table>");
l.document.close();
l.top = d.y-10;
zz = d.x;
//alert( l.clip.right+ " " + (window.innerWidth -30) );
if( zz + l.clip.right > window.innerWidth ){
zz = (window.innerWidth-30) - l.clip.right;
if( zz < 0 ){
zz = 0;
}
}
l.left = zz;
l.visibility="show";
return false;
}
note_array = new Array();
</script>
<layer name="popup" onMouseOut="this.visibility='hide';" left=0 top=0 bgcolor="#ffffff" visibility="hide">
</layer>
ENDJS
$script_str .= "
<script>
function js_qr(tree,mindate, maxdate, who ){
if (tree == 0 ){
return '../bonsai/cvsquery.cgi?module=${cvs_module}&branch=${cvs_branch}&cvsroot=${cvs_root}&date=explicit&mindate='
+ mindate + '&maxdate=' +maxdate + '&who=' + who ;
}
else {
return '../bonsai/cvsquery.cgi?module=$td2->{cvs_module}&branch=$td2->{cvs_branch}&cvsroot=$td2->{cvs_root}&date=explicit&mindate='
+ mindate + '&maxdate=' +maxdate + '&who=' + who ;
}
}
function js_qr24(tree,who){
if (tree == 0 ){
return '../bonsai/cvsquery.cgi?module=${cvs_module}&branch=${cvs_branch}&cvsroot=${cvs_root}&date=day'
+ '&who=' +who;
}
else{
return '../bonsai/cvsquery.cgi?module=$td2->{cvs_module}&branch=$td2->{cvs_branch}&cvsroot=$td2->{cvs_root}&date=day'
+ '&who=' +who;
}
}
";
$i = 0;
while( $i < @note_array ){
$s = $note_array[$i];
$s =~ s/\\/\\\\/g;
$s =~ s/\"/\\\"/g;
$s =~ s/\n/\\n/g;
$script_str .= "note_array[$i] = \"$s\";\n";
$i++;
}
$script_str .= "</script>\n";
}
sub do_express {
local($mailtime, $buildtime, $buildname, $errorparser, $buildstatus, $logfile);
local($buildrec);
local(%build);
open(BUILDLOG, "<$form{'tree'}/build.dat" ) || die ;
while( <BUILDLOG> ){
chop;
($mailtime, $buildtime, $buildname, $errorparser, $buildstatus, $logfile) =
split( /\|/ );
if( $buildstatus eq 'success' || $buildstatus eq 'busted'){
$build{$buildname} = $buildstatus;
}
}
close( BUILDLOG );
@keys = sort keys %build;
$keycount = @keys;
$treename = $form{tree};
$tm = &print_time(time);
print "<table border=1 align=center><tr><th colspan=$keycount><a href=showbuilds.cgi?tree=$treename>$tree as of $tm</a></tr>"
."<tr>\n";
for $buildname (@keys ){
if( $build{$buildname} eq 'success' ){
print "<td bgcolor=00ff00>";
}
else {
print "<td bgcolor=000000 background=1afi003r.gif>";
print "<font color=white>\n";
}
print "$buildname";
}
print "</tr></table>\n";
}

136
webtools/tinderbox/showimages.cgi Executable file
Просмотреть файл

@ -0,0 +1,136 @@
#!/usr/bonsaitools/bin/perl --
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Tinderbox build tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
$| = 1;
use lib "../bonsai";
require 'globals.pl';
require 'imagelog.pl';
require 'lloydcgi.pl';
require 'header.pl';
check_password();
print "Content-type: text/html\n\n";
@url = ();
@quote = ();
@width = ();
@height = ();
$i = 0;
EmitHtmlHeader("tinderbox: all images");
print '<UL>
<P>These are all of the images currently in
<A HREF=http://www.mozilla.org/tinderbox.html>Tinderbox</A>.
<P>Please don\'t give out this URL: this is only here for our debugging
needs, and isn\'t linked to by the rest of Tinderbox: because looking at
all the images at once would be be cheating! you\'re supposed to let them
surprise you over time. What, do you read ahead in your desktop calendar,
too? Where\'s your sense of mystery and anticipation?
<P>
</UL>
';
if ($form{'url'} ne "") {
$oldname = "$data_dir/imagelog.txt";
open (OLD, "<$oldname") || die "Oops; can't open imagelog.txt";
$newname = "$oldname-$$";
open (NEW, ">$newname") || die "Can't open $newname";
$foundit = 0;
while (<OLD>) {
chop;
($url, $width, $height, $quote) = split(/\`/);
if ($url eq $form{'url'} && $quote eq $form{'origquote'}) {
$foundit = 1;
if ($form{'nukeit'} ne "") {
next;
}
$quote = $form{'quote'};
}
print NEW "$url`$width`$height`$quote\n";
}
close OLD;
close NEW;
if (!$foundit) {
print "<font color=red>Hey, couldn't find it!</font> Did someone\n";
print "else already edit it?<P>\n";
unlink $newname;
} else {
print "Change made.<P>";
rename ($newname, $oldname) || die "Couldn't rename $newname to $oldname";
}
$form{'doedit'} = "1";
}
$doedit = ($form{'doedit'} ne "");
if (!$doedit) {
print "
<form method=post>
<input type=hidden name=password value=\"$form{'password'}\">
<input type=hidden name=doedit value=1>
<input type=submit value='Let me edit text or remove pictures.'>
</form><P>";
}
open( IMAGELOG, "<$data_dir/imagelog.txt" ) || die "can't open file";
while( <IMAGELOG> ){
chop;
($url[$i],$width[$i],$height[$i],$quote[$i]) = split(/\`/);
$i++;
}
close( IMAGELOG );
$i--;
print "<center>";
while( $i >= 0 ){
$qurl = value_encode($url[$i]);
$qquote = value_encode($quote[$i]);
print "
<img border=2 src='$url[$i]' width='$width[$i]' height='$height[$i]'><br>
<i>$quote[$i]</i>";
if ($doedit) {
print "
<form method=post>
<input type=submit name=nukeit value='Delete this image'><br>
<input name=quote size=60 value=\"$qquote\"><br>
<input type=submit name=edit value='Change text'><hr>
<input type=hidden name=url value=\"$qurl\">
<input type=hidden name=origquote value=\"$qquote\">
<input type=hidden name=password value=\"$form{'password'}\">
</form>";
}
print "<br><br>\n";
$i--;
}

282
webtools/tinderbox/showlog.cgi Executable file
Просмотреть файл

@ -0,0 +1,282 @@
#!/usr/bonsaitools/bin/perl --
# -*- Mode: perl; indent-tabs-mode: nil -*-
#
# The contents of this file are subject to the Netscape Public License
# Version 1.0 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/NPL/
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
# License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is the Tinderbox build tool.
#
# The Initial Developer of the Original Code is Netscape Communications
# Corporation. Portions created by Netscape are Copyright (C) 1998
# Netscape Communications Corporation. All Rights Reserved.
use lib "../bonsai";
require 'globals.pl';
require 'lloydcgi.pl';
require 'header.pl';
$|=1;
$LINES_AFTER_ERROR = 5;
$LINES_BEFORE_ERROR = 30;
$error_file = '';
$error_file_ref = '';
$error_line = 0;
$error_guess = 0;
print "Content-type: text/html\n\n";
$error_count = 0;
$next_err = 0;
@log_errors = ();
$log_ln = 0;
if (1) {
$tree = $form{'tree'};
$errorparser = $form{'errorparser'};
$logfile = $form{'logfile'};
$summary = $form{'summary'};
$buildname = $form{'buildname'};
$buildtime = $form{'buildtime'};
$enc_buildname = &url_encode($buildname);
$frames = $form{'frames'};
$fulltext = $form{'fulltext'};
$mainframe = $form{'mainframe'};
#print "$buildname \n $buildtime \n $errorparser \n $logfile \n $tree \n $enc_buildname \n";
}
else {
$tree = 'FreeSource';
$errorparser = 'windows';
$logfile = '19692.gz';
}
die "the \"tree\" parameter must be provided\n" unless $tree;
require "$tree/treedata.pl";
if( $mainframe ){
print "
<HTML>
<FRAMESET name = main ROWS='70%, 30%'>
<FRAME NAME='log' SCROLL=AUTO SRC='showlog.cgi?tree=$tree&errorparser=$errorparser&logfile=$logfile&summary=$summary&buildtime=$buildtime&buildname=$enc_buildname&fulltext=$fulltext&frames=1'>
<FRAME NAME='SOURCEFRAME' SCROLL='AUTO' SRC='Empty.html'>
</FRAMESET>
</HTML>
";
exit 0;
}
if( $frames ){
$source_target = "target=SOURCEFRAME";
}
#
# Dynamically load the error parser
#
die "the \"errorparser\" parameter must be provided\n" unless $errorparser;
require "ep_${errorparser}.pl";
$time_str = print_time( $form{'buildtime'} );
if( $fulltext ){
$s = 'Show <b>Brief</b> Log';
$s1 = '';
$s2 = 'Full';
}
else {
$s = 'Show <b>Full</b> Log';
$s1 = 1;
$s2 = 'Brief';
}
print "<META HTTP-EQUIV=\"EXPIRES\" CONTENT=\"1\">\n";
my $heading = "Build Log ($s2)";
my $subheading = "$form{'buildname'} on $time_str";
my $title = "$heading - $subheading";
EmitHtmlTitleAndHeader($title, $heading, $subheading);
print "
<font size=+1>
<dt><a href='showlog.cgi?tree=$tree&errorparser=$errorparser&logfile=$logfile&summary=$summary&buildtime=$buildtime&buildname=$enc_buildname&fulltext=$s1&frames=1'>$s</a>
<dt><a href=\"showbuilds.cgi?tree=$form{'tree'}\">Return to the Build Page</a>
<dt><a href=\"addnote.cgi?tree=$tree\&buildname=$enc_buildname\&buildtime=$buildtime\&logfile=$logfile\&errorparser=$errorparser\">
Add a Comment to the Log</a>
</font>
";
#
# Print notes
#
$found_note = 0;
open(NOTES,"<$tree/notes.txt") || print "<h2>warning: Couldn't open $tree/notes.txt </h2>\n";
while(<NOTES>){
chop;
($nbuildtime,$nbuildname,$nwho,$nnow,$nenc_note) = split(/\|/);
#print "$_<br>\n";
if( $nbuildtime == $buildtime && $nbuildname eq $buildname ){
if( !$found_note ){
print "<H2>Build Comments</H2>\n";
$found_note = 1;
}
$now_str = &print_time($nnow);
$note = &url_decode($nenc_note);
print "<pre>\n[<b><a href=mailto:$nwho>$nwho</a> - $now_str</b>]\n$note\n</pre>";
}
}
close(NOTES);
#
# Print the summery fisrt
#
print "
<H2>Build Error Summary</H2>
<p> Click error to take you to the error in the log.
<PRE>
";
$log_ln = 0;
open( BUILD_IN, "$gzip -d -c $tree/$logfile|" );
while( $line = <BUILD_IN> ){
&output_summary_line( $line );
}
close( BUILD_IN );
push @log_errors, 9999999;
print "</PRE>\n";
#
# reset the error counter
#
$next_err = 0;
print "<H2>Build Error Log</H2>\n<pre>";
$log_ln = 0;
open( BUILD_IN, "$gzip -d -c $tree/$logfile|" );
while( $line = <BUILD_IN> ){
&output_log_line( $line );
}
close( BUILD_IN );
print
"</PRE>
<p>
<font size=+1><a name=\"err$next_err\">No More Errors</a></font>
<br>
<br>
<br>
";
sub output_summary_line {
local( $line ) = @_;
local( $has_error );
$has_error = &has_error( $line );
$line =~ s/&/&amp;/g;
$line =~ s/</&lt;/g;
if( $has_error ){
push @log_errors, $log_ln + $LINES_AFTER_ERROR;
if( ! $last_was_error ) {
print "<a href=\"#err$next_err\">$line</a>";
$next_err++;
}
$last_was_error = 1;
}
else {
$last_was_error = 0;
}
$log_ln++;
}
sub output_log_line {
local( $line, $bSummary ) = @_;
local( $has_error, $dur, $dur_min,$dur_sec, $dur_str, $logline );
$has_error = &has_error( $line );
$has_warning = &has_warning( $line );
$line =~ s/&/&amp;/g;
$line =~ s/</&lt;/g;
$logline = '';
if( ($has_error || $has_warning) && &has_errorline( $line ) ) {
$q = quotemeta( $error_file );
#$goto_line = ($error_line ? 10 > $error_line - 10 : 1 );
$goto_line = ($error_line > 10 ? $error_line - 10 : 1 );
$cvsblame = ($error_guess ? "cvsguess.cgi" : "cvsblame.cgi");
$line =~ s@$q@<a href=../bonsai/$cvsblame?file=$error_file_ref&rev=$cvs_branch&mark=$error_line#$goto_line $source_target>$error_file</a>@
}
if( $has_error ){
if( ! $last_was_error ) {
$logline .= "<a name=\"err$next_err\"></a>";
$next_err++;
$logline .= "<a href=\"#err$next_err\">NEXT</a> ";
}
else {
$logline .= " ";
}
$logline .= "<font color=\"000080\">$line</font>";
$last_was_error = 1;
}
elsif( $has_warning ){
$logline .= " ";
$logline .= "<font color=000080>$line</font>";
}
else {
$logline .= " $line";
$last_was_error = 0;
}
&push_log_line( $logline );
}
sub push_log_line {
local( $ln ) = @_;
if( $fulltext ){
print $ln;
return;
}
if( $log_ln > $log_errors[$cur_error] ){
$cur_error++;
}
if( $log_ln >= $log_errors[$cur_error] - $LINES_BEFORE_ERROR ){
if( $log_skip != 0 ){
print "\n<i><font size=+1> Skipping $log_skip Lines...</i></font>\n\n";
$log_skip = 0;
}
print $ln;
}
else {
$log_skip++;
}
$log_ln++;
}

Двоичные данные
webtools/tinderbox/star.gif Normal file
Просмотреть файл

Двоичный файл не отображается.
Режим "рядом"

После

Ширина:  |  Высота:  |  Размер: 227 B