[ooo-build-commit] .: Branch 'tinderbox.go-oo.org' - 2 commits - addnote.cgi admintree.cgi bustagestats.cgi cgi-bin/addnote.cgi cgi-bin/admintree.cgi cgi-bin/bustagestats.cgi cgi-bin/cvsquery.cgi cgi-bin/cvsqueryform.cgi cgi-bin/gunzip.cgi cgi-bin/oracleregexp.cgi cgi-bin/regenerate.cgi cgi-bin/tinder.cgi cvsquery.cgi cvsqueryform.cgi .gitignore gunzip.cgi oracleregexp.cgi regenerate.cgi tinder.cgi
Jan Holesovsky
kendy at kemper.freedesktop.org
Thu Aug 19 04:07:38 PDT 2010
.gitignore | 7
addnote.cgi | 388 --------------------------
admintree.cgi | 659 --------------------------------------------
bustagestats.cgi | 124 --------
cgi-bin/addnote.cgi | 388 ++++++++++++++++++++++++++
cgi-bin/admintree.cgi | 659 ++++++++++++++++++++++++++++++++++++++++++++
cgi-bin/bustagestats.cgi | 124 ++++++++
cgi-bin/cvsquery.cgi | 701 +++++++++++++++++++++++++++++++++++++++++++++++
cgi-bin/cvsqueryform.cgi | 309 ++++++++++++++++++++
cgi-bin/gunzip.cgi | 169 +++++++++++
cgi-bin/oracleregexp.cgi | 86 +++++
cgi-bin/regenerate.cgi | 129 ++++++++
cgi-bin/tinder.cgi | 555 +++++++++++++++++++++++++++++++++++++
cvsquery.cgi | 701 -----------------------------------------------
cvsqueryform.cgi | 309 --------------------
gunzip.cgi | 169 -----------
oracleregexp.cgi | 86 -----
regenerate.cgi | 129 --------
tinder.cgi | 555 -------------------------------------
19 files changed, 3127 insertions(+), 3120 deletions(-)
New commits:
commit 1b8414288eb78bad9f801e4103a4ef6d1f27faf5
Author: Jan Holesovsky <kendy at suse.cz>
Date: Thu Aug 19 12:56:00 2010 +0200
Add .gitignore.
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..f2cfde1
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,7 @@
+# Ignore everything
+*
+# but:
+!.gitignore
+!cgi-bin
+!favicon.*
+!robots.txt
commit 9610c797328a43a1bc43c257b6806990636154ed
Author: Jan Holesovsky <kendy at suse.cz>
Date: Thu Aug 19 12:54:24 2010 +0200
Moved the scripts to cgi-bin subdir.
diff --git a/addnote.cgi b/addnote.cgi
deleted file mode 100755
index 87351c9..0000000
--- a/addnote.cgi
+++ /dev/null
@@ -1,388 +0,0 @@
-#!/usr/bin/perl -T --
-# -*- Mode: perl; indent-tabs-mode: nil -*-
-#
-
-# addnote.cgi - the webform via which users enter notices to be
-# displayed on the tinderbox status page.
-
-
-# $Revision: 1.25 $
-# $Date: 2004/04/19 12:42:16 $
-# $Author: kestes%walrus.com $
-# $Source: /cvsroot/mozilla/webtools/tinderbox2/src/bin/addnote.cgi,v $
-# $Name: $
-
-# The contents of this file are subject to the Mozilla Public
-# License Version 1.1 (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.
-#
-
-# complete rewrite by Ken Estes for contact info see the
-# mozilla/webtools/tinderbox2/Contact file.
-# Contributor(s):
-
-
-
-# Standard perl libraries
-use CGI ':standard';
-use File::Basename;
-
-# Tinderbox libraries
-
-use lib '/srv/tinderbox/local_conf',
- '/srv/tinderbox/default_conf',
- '/srv/tinderbox/lib';
-
-use TinderConfig;
-use FileStructure;
-use TreeData;
-use Persistence;
-use HTMLPopUp;
-use Utils;
-use TinderDB;
-use TinderHeader;
-
-
-# turn a time string of the form "04/26 15:48" into a time().
-
-sub timestring2time {
- my ($string) = @_;
- my $time;
-
- if ($string =~ m!\s*(\d+)/(\d+)\s+(\d+):(\d+)\s*!) {
-
- my ($mon, $mday, $hours, $min,) = ($1, $2, $3, $4);
-
- # we are only interested in history in our recent
- # past, within the last year.
-
- # The perl conventions for these variables is 0 origin while the
- # "display" convention for these variables is 1 origin.
- $mon--;
-
- # This calculation may use the wrong year.
- my @time = localtime(time());
- my $year = $time[5] + 1900;
-
- my $sec = 0;
-
- $time = timelocal($sec,$min,$hours,$mday,$mon,$year);
-
- # This fix is needed every year on Jan 1. On that day $time is
- # nearly a year in the future so is much bigger then $main::TIME.
-
- if ( ($time - $main::TIME) > $main::SECONDS_PER_MONTH) {
- $time = timelocal($sec,$min,$hours,$mday,$mon,$year - 1);
- }
-
- }
-
- # check that the result is reasonable.
-
- if ( (($main::TIME - $main::SECONDS_PER_YEAR) > $time) ||
- (($main::TIME + $main::SECONDS_PER_MONTH) < $time) ) {
- undefine $time;
- }
-
- return $time;
-}
-
-# turn a time() into a string time of the form "04/26 15:48".
-
-sub time2timestring {
- my ($time) = @_;
-
- my ($sec,$min,$hour,$mday,$mon,
- $year,$wday,$yday,$isdst) =
- localtime($time);
-
- $mon++;
- $year += 1900;
- my $display_time = sprintf("%02u/%02u %02u:%02u",
- $mon, $mday, $hour, $min);
-
- return $display_time;
-}
-
-
-sub get_params {
-
- $SIG{'__DIE__'} = \&fatal_error;
-
- $REMOTE_HOST = remote_host();
- $TREE = param("tree");
- (TreeData::tree_exists($TREE)) ||
- die("tree: $TREE does not exist\n");
-
- # tree is safe, untaint it.
- $TREE =~ m/(.*)/;
- $TREE = $1;
-
- $MAILADDR = ( param("mailaddr") ||
- cookie(-name=>"tinderbox_mailaddr"));
-
- if (param("effectivetime")) {
- $EFFECTIVE_TIME = timestring2time( param("effectivetime") );
-
- # allow people to backdate notices but not forward date them.
- if ($EFFECTIVE_TIME > $TIME) {
- $EFFECTIVE_TIME = $TIME;
- }
- } else {
- $EFFECTIVE_TIME = time();
- }
-
- $MAILADDR = main::extract_user($MAILADDR);
-
- $USE_COOKIE = param("use_cookie");
- ($USE_COOKIE) &&
- ($USE_COOKIE = 1);
-
- $REMOTE_HOST = remote_host();
-
- $NOTE=param("note");
-
- # Remove any known "bad" tags. Since any user can post notices we
- # have to prevent bad scripts from being posted.
-
- $NOTE = extract_html_chars($NOTE);
-
- {
- TinderDB::loadtree_db($TREE);
-
- @ASSOCIATIONS = TinderDB::notice_association($TREE);
- }
-
- @CHOSEN_ASSOCIATIONS = param("associations");
-
- return 1;
-}
-
-
-
-
-sub format_input_page {
- my ($tree) = @_;
-
- my (@out);
-
- my ($title) = "Add a Notice to tree: $tree";
-
-
- my ($sec,$min,$hour,$mday,$mon,
- $year,$wday,$yday,$isdst) =
- localtime($EFFECTIVE_TIME);
- $mon++;
- $year += 1900;
- my $display_effective_time = sprintf("%02u/%02u %02u:%02u",
- $mon, $mday, $hour, $min);
-
- push @out, (
- start_html(-title=>$title),
- h2($title),
- start_form,
- );
-
- push @out, (
- HTMLPopUp::Link(
- "linktxt"=>"Return to tree: $tree",
- "href"=> FileStructure::get_filename($tree, 'tree_URL').
- "/$FileStructure::DEFAULT_HTML_PAGE",
- ).
- p());
-
- push @out, (
- "Email address: ",p(),
- textfield(-name=>'mailaddr',
- -default=>$MAILADDR),
- p(),
- checkbox( -label=>"remember mail address as a cookie",
- -name=>"use_cookie"),
- p(),
- );
-
- push @out, (
- "Effective Time: \n",p(),
- textarea(-name=>'effectivetime',
- -default=>$display_effective_time,
- -rows=>1, -cols=>20, -wrap=>'physical',),
- p(),
- );
-
- if (@ASSOCIATIONS) {
-
- push @out, (
- h3("Associated with"),
- p(),
- checkbox_group(
- -name=>'associations',
- -value=>[@ASSOCIATIONS],
- # -default=>,
- ),
- p(),
- );
- } # end if
-
- push @out, (
- "Enter Notice: \n",p(),
- textarea(-name=>'note',
- -rows=>10, -cols=>30, -wrap=>'physical',),
- p(),
- );
-
- push @out, (
- submit(-name=>'Submit'),
- p(),
- );
-
- # We need the post operation to remember all the parameters which
- # were passed as arguments as well as those passed as form
- # variables.
-
- foreach $param ( param() ) {
- push @out, hidden($param)."\n";
- }
-
-
- push @out, end_form;
-
- push @out, "\n\n\n";
-
- return @out;
-}
-
-
-
-
-sub save_note {
- my ($tree) = @_;
-
- my (@out);
-
- my ($localtime) = localtime($EFFECTIVE_TIME);
-
- my %association;
- foreach $association (@CHOSEN_ASSOCIATIONS) {
- $association{$association} = 1;
- }
-
- # We embed the IP address of the host, just in case there is some bad
- # html in the notice that gets through our defenses. If we know that
- # there is a problem with a page, then we know which machine it came
- # from.
-
- my ($record) = {
- 'tree' => $TREE,
- 'mailaddr' => $MAILADDR,
- 'note' => $NOTE,
- 'time' => $EFFECTIVE_TIME,
- 'localtime' => $localtime,
- 'posttime' => $TIME,
- 'localposttime' => $LOCALTIME,
- 'remote_host' => $REMOTE_HOST,
- 'associations' => \%association,
- };
-
- my ($update_file) = (FileStructure::get_filename($TREE, 'TinderDB_Dir').
- "/Notice\.Update\.$TIME\.$MAILADDR");
-
- $update_file =~ s/\@/\./g;
- $update_file = main::extract_safe_filename($update_file);
-
- Persistence::save_structure(
- $record,
- $update_file
- );
-
- push @out, "posted notice: \n",p().
- pre($NOTE);
-
- HTMLPopUp::regenerate_HTML_pages();
-
- return @out;
-}
-
-
-# save the note to disk and update the cookies
-
-sub make_all_changes {
- my (@results) = ();
-
- my $submit = param("Submit");
-
- if ($submit) {
- push @results, save_note($TREE);
-
- if ($USE_COOKIE) {
- # this must be called before header()
-
- my ($cookie1,);
- my ($expires) = 'Sun, 1-Mar-2020 00:00:00 GMT';
- my ($mailaddr) = param('mailaddr');
-
- $cookie1 = cookie(
- -name=>"tinderbox_mailaddr",
- -value=>$mailaddr,
- -expires => $expires,
- -path=>'/',
- );
- $SET_COOKIES = [$cookie1,];
- }
-
- if (@results) {
- @results = (
- h2("Update Results"),
- p()."\n",
- join (p(), (
- "Remote host: $REMOTE_HOST\n",
- "Local Time: $LOCALTIME\n",
- "Mail Address: $MAILADDR\n",
- @results,
- )
- ),
- "\n\n",
- );
- }
- }
-
- return @results;
-}
-
-
-
-
-# Main
-{
- set_static_vars();
- get_env();
- chk_security();
-
- get_params();
-
- my (@out) = make_all_changes();
-
- print header(-cookie=>$SET_COOKIES);
-
- push @out, format_input_page($TREE);
-
- print @out;
-
- print end_html();
-
- print "\n\n\n";
-
- exit 0;
-}
diff --git a/admintree.cgi b/admintree.cgi
deleted file mode 100755
index 58b1ada..0000000
--- a/admintree.cgi
+++ /dev/null
@@ -1,659 +0,0 @@
-#!/usr/bin/perl -T --
-# -*- Mode: perl; indent-tabs-mode: nil -*-
-#
-
-# admintree.cgi - the webform used by administrators to close the
-# tree, set the message of the day and stop build
-# columns from being shown on the default pages.
-
-
-# $Revision: 1.26 $
-# $Date: 2004/08/07 13:12:10 $
-# $Author: kestes%walrus.com $
-# $Source: /cvsroot/mozilla/webtools/tinderbox2/src/bin/admintree.cgi,v $
-# $Name: $
-
-# The contents of this file are subject to the Mozilla Public
-# License Version 1.1 (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.
-#
-
-# complete rewrite by Ken Estes for contact info see the
-# mozilla/webtools/tinderbox2/Contact file.
-# Contributor(s):
-
-
-
-# Standard perl libraries
-use File::Basename;
-use CGI ':standard';
-
-# Tinderbox libraries
-
-use lib '/srv/tinderbox/local_conf',
- '/srv/tinderbox/default_conf',
- '/srv/tinderbox/lib';
-
- # '/home/ooweb/mozilla/webtools/tinderbox2/./build/local_conf',
- # '/home/ooweb/mozilla/webtools/tinderbox2/./build/default_conf',
- # '/home/ooweb/mozilla/webtools/tinderbox2/./build/lib';
-
-use TinderConfig;
-use TreeData;
-use FileStructure;
-use Persistence;
-use TinderHeader;
-use Utils;
-use HTMLPopUp;
-
-
-# Normally we filter user input for 'tainting' and to prevent this:
-
-# http://www.ciac.org/ciac/bulletins/k-021.shtml
-
-# When a victim with scripts enabled in their browser reads this
-# message, the malicious code may be executed
-# unexpectedly. Scripting tags that can be embedded in this way
-# include <SCRIPT>, <OBJECT>, <APPLET>, and <EMBED>.
-
-# note that we want some tags to be allowed (href) but not #
-# others. This requirement breaks the taint perl mechanisms for #
-# checking as we can not escape every '<>'.
-
-# However we trust our administrators not to put bad things in the web
-# pages and we wish to allow them to embed scripts.
-
-
-sub get_params {
-
- $TREE = param("tree");
- (TreeData::tree_exists($TREE)) ||
- die("tree: $TREE does not exist\n");
-
- # tree is safe, untaint it.
- $TREE =~ m/(.*)/;
- $TREE = $1;
-
- $MAILADDR = ( param("mailaddr") ||
- cookie(-name=>"tinderbox_mailaddr"));
- $MAILADDR = main::extract_user($MAILADDR);
-
- $NEW_BANNER = param("banner");
- $NEW_BANNER = extract_printable_chars($NEW_BANNER);
-
- $NEW_MOTD = param("motd");
- $NEW_MOTD = extract_printable_chars($NEW_MOTD);
-
- $NEW_TREE_STATE = param("tree_state");
- $NEW_TREE_STATE = extract_printable_chars($NEW_TREE_STATE);
-
- $NEW_ADMIN = param("newadmin");
- $NEW_ADMIN = extract_printable_chars($NEW_ADMIN);
-
- $USE_COOKIE = param("use_cookie");
- ($USE_COOKIE) &&
- ($USE_COOKIE = 1);
-
- $PASSWD = ( param("passwd") ||
- cookie(-name=>"tinderbox_password_$TREE"));
-
- $NEW_PASSWD1 = param('newpasswd1');
- $NEW_PASSWD2 = param('newpasswd2');
-
- @NEW_IGNORE_BUILDS = param("ignore_builds");
- @NEW_IGNORE_BUILDS = uniq(@NEW_IGNORE_BUILDS);
-
- $REMOTE_HOST = remote_host();
-
- $ADMINISTRATIVE_NETWORK_PAT = ($TinderConfig::ADMINISTRATIVE_NETWORK_PAT ||
- '.*');
-
- return ;
-}
-
-
-
-sub setup_environment {
-
- $CURRENT_TREE_STATE = TinderHeader::gettree_header('TreeState', $TREE);
-
- @CURRENT_IGNORE_BUILDS = get_current_ignore_builds($TREE);
-
- $CURRENT_BANNER = TinderHeader::gettree_header('Banner', $TREE);
-
- $CURRENT_MOTD = TinderHeader::gettree_header('MOTD', $TREE);
-
- get_passwd_table();
-
- return ;
-}
-
-
-
-
-sub encrypt_passwd {
- my ($passwd) = @_;
-
- # The man page for Crypt says:
-
- # KEY is the input string to encrypt, for instance, a user's
- # typed password. Only the first eight characters are used; the
- # rest are ignored.
-
- my $salt = 'aa';
- my $encoded = crypt($passwd, $salt);
-
- return $encoded;
-}
-
-
-
-sub get_passwd_table {
-
- my ($file) = FileStructure::get_filename($TREE, 'passwd');
-
- (-r $file) ||
- return ;
-
- my ($r) = Persistence::load_structure($file);
- $PASSWD_TABLE{$TREE} = $r;
-
- return ;
-}
-
-
-
-# peek inside TinderDB::Build to get the names of the builds for this
-# tree
-
-sub get_build_names {
- my ($tree) = @_;
- my (@build_names);
-
- # we need an eval since the builds may not be configured
-
- eval {
- local $SIG{'__DIE__'} = sub { };
-
- use TinderDB::Build;
-
- my ($build_obj) = TinderDB::Build->new();
-
- $build_obj->loadtree_db($tree);
-
- @build_names = TinderDB::Build::all_build_names($tree);
- };
-
- return @build_names;
-}
-
-
-
-sub get_current_ignore_builds {
- my ($tree) = @_;
- my (@ignore_builds) = ();
-
- @ignore_builds = split(
- /,/,
- TinderHeader::gettree_header('IgnoreBuilds', $TREE)
- );
-
- @ignore_builds = uniq(@ignore_builds);
-
- # It is possible that the current ignore_builds for this tree are
- # not a subset of the current settings of buildnames, since the
- # two are not maintained together. Remove settings which no
- # longer apply.
-
- my (@build_names) = get_build_names($tree);
-
- my ($pat) = '';
-
- foreach $build_name (@build_names) {
- # careful some buildnames may have '()' or
- # other metacharacters in them.
-
- $pat .= "\^". quotemeta($build_name)."\$".
- "\|";
- }
- chop $pat;
-
- @ignore_builds = grep(/$pat/, @ignore_builds);
-
-
- return @ignore_builds;
-}
-
-
-
-
-sub format_input_page {
- my ($tree)= @_;
- my (@build_names) = get_build_names($tree);
- my (@tree_states) = $TinderHeader::NAMES2OBJS{'TreeState'}->
- get_all_sorted_setable_tree_states();
-
- my ($title) = "Tinderbox Adminstration for Tree: $tree";
- my (@out);
-
- my $passwd_string = '';
- if ( !(keys %{ $PASSWD_TABLE{$TREE} }) ) {
- $passwd_string = h3(font({-color=>'red'},
- "No administrators set, ".
- "no passwords needed."));
- }
-
- push @out, (
- start_html(-title=>$title),
- h2({-align=>'CENTER'},
- $title),
- start_form
- );
-
- push @out, (
- HTMLPopUp::Link(
- "linktxt"=>"Return to tree: $tree",
- "href"=> FileStructure::get_filename($tree, 'tree_URL').
- "/$FileStructure::DEFAULT_HTML_PAGE",
- ).
- p());
-
- push @out, (
-
- # if we know mailaddr send it back as the default to
- # show we know the user, do not bother to send the
- # passwd back in the form.
-
- h3("Login",),
- $passwd_string,
- "Email address: ",
- textfield(-name=>'mailaddr',
- -default=>$MAILADDR,
- -size=>30,),
- "Password: ".
- password_field(-name=>'passwd', -size=>8,),
- p(),
- checkbox( -label=>("If correct, ".
- "remember password and email field ".
- "as a cookie"),
- -name=>'use_cookie'),
- p(),
- );
-
- push @out, (
- h3("Change Password",),
- "Enter the new password twice: <br>\n",
- "(Only the first eight characters are significant)<p>\n",
- p(),
- password_field(-name=>'newpasswd1', -size=>8,),
- password_field(-name=>'newpasswd2', -size=>8,),
- p(),
- );
-
- push @out, (
- h3("Add New Administrator",),
- "Enter the new administrators Email Address: <br>\n",
- "(default password will be same as administrators name)<p>\n",
- p(),
- textfield(-name=>'newadmin', -size=>30,),
- p(),
- );
-
- if (@tree_states) {
-
- push @out, (
- h3("Tree State"),
- "Change the State of the Tree:",
- p(),
- radio_group(-name=>'tree_state',
- -value=>[@tree_states],
- -default=>$CURRENT_TREE_STATE,),
- p(),
- )
- } # end if
-
- if (@build_names) {
- push @out, (
- h3("Unmonitored Builds"),
- "The set of Builds which will not normally be displayed: ",
- p(),
- checkbox_group(-name=>'ignore_builds',
- -value=>[@build_names],
- -default=>[@CURRENT_IGNORE_BUILDS],),
- p(),
- )
- } # end if
-
- push @out, (
- h3("Banner"),
- "New Banner, global to all projects (must be valid HTML)",p(),
- textarea(-name=>'banner', -default=>$CURRENT_BANNER,
- -rows=>30, -cols=>75, -wrap=>'physical',),
- p(),
- );
-
- push @out, (
- h3("Message of the Day"),
- "New Message of the Day (must be valid HTML)",p(),
- textarea(-name=>'motd', -default=>$CURRENT_MOTD,
- -rows=>30, -cols=>75, -wrap=>'physical',),
- p(),
- );
-
- push @out, (
-# the default does not work because the tree gets reset to null
-# defaults(-name=>'Defaults',),
- submit(-name=>'Submit'),
- p(),
- );
-
- # We need the post operation to remember all the parameters which
- # were passed as arguments as well as those passed as form
- # variables.
-
- foreach $param ( param() ) {
- push @out, hidden($param)."\n";
- }
-
-
- push @out, end_form;
-
- return @out;
-}
-
-
-
-
-
-sub save_passwd_table {
- my ($file) = FileStructure::get_filename($TREE, 'passwd');
-
- # We expect tree administration to be a rare event and each change
- # should be independent and noncontradictory, so we do not worry
- # about locking during the updates but we make an effort to keep the
- # updates atomic.
-
- if ( keys %{ $PASSWD_TABLE{$TREE} } ) {
- Persistence::save_structure($PASSWD_TABLE{$TREE},$file);
- }
-
- return ;
-}
-
-
-
-sub change_passwd {
- my (@results) = ();
-
- if (($NEW_PASSWD1) &&
- ($NEW_PASSWD1 ne $PASSWD ) ) {
-
- if ($NEW_PASSWD1 eq $NEW_PASSWD2) {
-
- # we need to reload the password table so that the check against
- # existing administrators is nearly atomic.
-
- get_passwd_table();
-
- my ($new_encoded1) = encrypt_passwd($NEW_PASSWD1);
- $PASSWD_TABLE{$TREE}{$MAILADDR} = $new_encoded1;
- save_passwd_table();
-
- push @results, "Password changed.\n";
- } else {
- push @results, ("New passwords do not match, ".
- "password not changed.\n");
- }
-
- }
-
- return @results;
-}
-
-
-sub add_new_administrator {
- my (@results) =();
-
- ($NEW_ADMIN) ||
- return ;
-
- ($NEW_ADMIN !~ m!\@!) &&
- return("New administrator: $NEW_ADMIN does not have an '\@' ".
- "in the email address.\n");
-
- # we need to reload the password table so that the check against
- # existing administrators is nearly atomic.
-
- get_passwd_table();
-
- ($PASSWD_TABLE{$TREE}{$NEW_ADMIN}) &&
- return("New administrator: $NEW_ADMIN already has an account.\n");
-
-
- $PASSWD_TABLE{$TREE}{$NEW_ADMIN} = encrypt_passwd($NEW_ADMIN);
- save_passwd_table();
- push @results, ("Added administrator: $NEW_ADMIN \n".
- "(default passwd is same as admin name)\n");
-
- return @results;
-}
-
-
-
-
-
-sub change_tree_state {
- my (@results) =();
-
- ($NEW_TREE_STATE) ||
- return ;
-
- ($NEW_TREE_STATE eq $CURRENT_TREE_STATE) &&
- return ;
-
- TinderHeader::savetree_header('TreeState', $TREE, $NEW_TREE_STATE);
- push @results, "Tree_State changed: $NEW_TREE_STATE\n";
-
- return @results;
-}
-
-
-
-sub change_ignore_builds {
- my (@results) = ();
- my (@out);
-
- ("@NEW_IGNORE_BUILDS" eq "@CURRENT_IGNORE_BUILDS") &&
- return ;
-
- $ignore_builds = join(',', @NEW_IGNORE_BUILDS);
- TinderHeader::savetree_header('IgnoreBuilds', $TREE, $ignore_builds);
-
- push @results, "ignore_builds changed: @NEW_IGNORE_BUILDS \n";
-
- return @results;
-}
-
-
-
-sub change_banner {
- my (@results) = ();
-
- # remember new_motd could be empty. As long as it is different than
- # old_motd we should save it.
-
- ($NEW_BANNER eq $CURRENT_BANNER) &&
- return ;
-
- TinderHeader::savetree_header('Banner', $TREE, $NEW_BANNER);
- push @results, "Banner changed: \n\t'\n$NEW_BANNER\n\t' \n";
-
- return @results;
-}
-
-
-sub change_motd {
- my (@results) = ();
-
- # remember new_motd could be empty. As long as it is different than
- # old_motd we should save it.
-
- ($NEW_MOTD eq $CURRENT_MOTD) &&
- return ;
-
- TinderHeader::savetree_header('MOTD', $TREE, $NEW_MOTD);
- push @results, "MOTD changed: \n\t'\n$NEW_MOTD\n\t' \n";
-
- return @results;
-}
-
-
-
-# return empty if there is no security problem otherwise return a list
-# of strings explaining the problem
-
-sub security_problem {
- my (@out) = ();
-
- ($REMOTE_HOST =~ m!$ADMINISTRATIVE_NETWORK_PAT!) ||
- (push @out, ("Error, Host: '$REMOTE_HOST' not valid. ".
- " Requests must be made from an IP address".
- " in an administrative network.\n"));
-
- # If they are not on a valid network they should not see what our
- # other security checks are.
-
- scalar(@out) &&
- return @out;
-
- ($MAILADDR) ||
- (push @out, "Error, No Mail Address\n");
-
- ($MAILADDR =~ m!\@!) ||
- (push @out, "Error, Mail Address must have '\@' in it.\n");
-
- if ( keys %{ $PASSWD_TABLE{$TREE}} ) {
- ($PASSWD) ||
- (push @out, "Error, must enter Password\n");
-
- my ($encoded) = encrypt_passwd($PASSWD);
-
- ($encoded eq $PASSWD_TABLE{$TREE}{$MAILADDR}) ||
- (push @out, "Error, Password Not Valid\n");
- }
-
- return @out;
-}
-
-
-
-# perform all the updates which have been requested.
-
-sub make_all_changes {
- my (@results) = ();
-
- my $submit = param("Submit");
-
- if ($submit) {
- @results = security_problem();
- my ($security_problems) = scalar(@results);
-
- if (!($security_problems)) {
- push @results, change_passwd();
- push @results, add_new_administrator();
- push @results, change_tree_state();
- push @results, change_ignore_builds();
- push @results, change_motd();
- push @results, ("Check changes are correct on the status page, ".
- "different administrators can change ".
- "the settings at the same time.");
-
- HTMLPopUp::regenerate_HTML_pages();
-
- } else {
- push @results, "No changes attempted due to security issues.";
- }
-
- if ( ($USE_COOKIE) && (!($security_problems)) ) {
- # this must be called before header()
-
- my ($cookie1, $cookie2);
- my ($expires) = 'Sun, 1-Mar-2020 00:00:00 GMT';
- my ($passwd) = param('passwd');
- my ($mailaddr) = param('mailaddr');
-
- $cookie1 = cookie(
- -name=>"tinderbox_password_$TREE",
- -value=>$passwd,
- -expires => $expires,
- -path=>'/',
- );
- $cookie2 = cookie(
- -name=>"tinderbox_mailaddr",
- -value=>$mailaddr,
- -expires => $expires,
- -path=>'/',
- );
- $SET_COOKIES = [$cookie1, $cookie2];
- }
-
- if (@results) {
- @results = (
- h2("Update Results"),
- p()."\n",
- join (p(), (
- "Remote host: $REMOTE_HOST\n",
- "Local Time: $LOCALTIME\n",
- "Mail Address: $MAILADDR\n",
- @results,
- )
- ),
- "\n\n",
- );
- log_warning(@results);
- }
- }
-
- return @results;
-}
-
-
-
-
-# Main
-{
- set_static_vars();
- get_env();
- chk_security();
-
- get_params();
-
- setup_environment();
-
- my (@out) = make_all_changes();
-
- print header(-cookie=>$SET_COOKIES);
-
- push @out, format_input_page($TREE);
-
- print @out;
-
- print end_html();
-
- print "\n\n\n";
-
- exit 0;
-}
diff --git a/bustagestats.cgi b/bustagestats.cgi
deleted file mode 100755
index 5247029..0000000
--- a/bustagestats.cgi
+++ /dev/null
@@ -1,124 +0,0 @@
-#!/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';
-
-use Date::Parse;
-use Date::Format;
-
-my $TIMEFORMAT = "%D %T";
-
-$|=1;
-
-print "Content-type: text/html\n\n<HTML>\n";
-
-# &load_data;
-
-EmitHtmlHeader("Statistics");
-
-my $tree = $form{'tree'};
-my $start = $form{'start'};
-my $end = $form{'end'};
-
-sub str2timeAndCheck {
- my ($str) = (@_);
- my $result = str2time($str);
- if (defined $result && $result > 7000000) {
- return $result;
- }
- print "<p><font color=red>Can't parse as a date: $str</font><p>\n";
- return 0;
-}
-
-if (defined $tree && defined $start && defined $end) {
- my $first = str2timeAndCheck($start);
- my $last = str2timeAndCheck($end);
- if ($first > 0 && $last > 0) {
- if (open(IN, "<$tree/build.dat")) {
- print "<hr><center><h1>Bustage stats for $tree</H1><H3>from " .
- time2str($TIMEFORMAT, $first) . " to " .
- time2str($TIMEFORMAT, $last) . "</H3></center>\n";
- my %stats;
- while (<IN>) {
- chomp;
- my ($mailtime, $buildtime, $buildname, $errorparser,
- $buildstatus, $logfile, $binaryname) =
- split( /\|/ );
- if ($buildtime >= $first && $buildtime <= $last) {
- if (!defined $stats{$buildname}) {
- $stats{$buildname} = 0;
- }
- if ($buildstatus eq "busted") {
- $stats{$buildname}++;
- }
- }
- }
- print "<table>\n";
- print "<tr><th>Build name</th><th>Number of bustages</th></tr>\n";
- foreach my $key (sort (keys %stats)) {
- print "<tr><td>$key</td><td>$stats{$key}</td></tr>\n";
- }
- print "</table>\n";
- } else {
- print "<p><font color=red>There does not appear to be a tree " .
- "named '$tree'.</font><p>";
- }
-
- }
- print "<hr>\n";
-}
-
-if (!defined $tree) {
- $tree = "";
-}
-
-if (!defined $start) {
- $start = time2str($TIMEFORMAT, time() - 7*24*60*60); # One week ago.
-}
-
-if (!defined $end) {
- $end = time2str($TIMEFORMAT, time()); # #now
-}
-
-
-print qq|
-<form>
-<table>
-<tr>
-<th align=right>Tree:</th>
-<td><input name=tree size=30 value="$tree"></td>
-</tr>
-<tr>
-<th align=right>Start time:</th>
-<td><input name=start size=30 value="$start"></td>
-</tr>
-<tr>
-<th align=right>End time:</th>
-<td><input name=end size=30 value="$end"></td>
-</tr>
-</table>
-
-<INPUT TYPE=\"submit\" VALUE=\"Generate stats \">
-
-</form>
-|;
diff --git a/cgi-bin/addnote.cgi b/cgi-bin/addnote.cgi
new file mode 100755
index 0000000..87351c9
--- /dev/null
+++ b/cgi-bin/addnote.cgi
@@ -0,0 +1,388 @@
+#!/usr/bin/perl -T --
+# -*- Mode: perl; indent-tabs-mode: nil -*-
+#
+
+# addnote.cgi - the webform via which users enter notices to be
+# displayed on the tinderbox status page.
+
+
+# $Revision: 1.25 $
+# $Date: 2004/04/19 12:42:16 $
+# $Author: kestes%walrus.com $
+# $Source: /cvsroot/mozilla/webtools/tinderbox2/src/bin/addnote.cgi,v $
+# $Name: $
+
+# The contents of this file are subject to the Mozilla Public
+# License Version 1.1 (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.
+#
+
+# complete rewrite by Ken Estes for contact info see the
+# mozilla/webtools/tinderbox2/Contact file.
+# Contributor(s):
+
+
+
+# Standard perl libraries
+use CGI ':standard';
+use File::Basename;
+
+# Tinderbox libraries
+
+use lib '/srv/tinderbox/local_conf',
+ '/srv/tinderbox/default_conf',
+ '/srv/tinderbox/lib';
+
+use TinderConfig;
+use FileStructure;
+use TreeData;
+use Persistence;
+use HTMLPopUp;
+use Utils;
+use TinderDB;
+use TinderHeader;
+
+
+# turn a time string of the form "04/26 15:48" into a time().
+
+sub timestring2time {
+ my ($string) = @_;
+ my $time;
+
+ if ($string =~ m!\s*(\d+)/(\d+)\s+(\d+):(\d+)\s*!) {
+
+ my ($mon, $mday, $hours, $min,) = ($1, $2, $3, $4);
+
+ # we are only interested in history in our recent
+ # past, within the last year.
+
+ # The perl conventions for these variables is 0 origin while the
+ # "display" convention for these variables is 1 origin.
+ $mon--;
+
+ # This calculation may use the wrong year.
+ my @time = localtime(time());
+ my $year = $time[5] + 1900;
+
+ my $sec = 0;
+
+ $time = timelocal($sec,$min,$hours,$mday,$mon,$year);
+
+ # This fix is needed every year on Jan 1. On that day $time is
+ # nearly a year in the future so is much bigger then $main::TIME.
+
+ if ( ($time - $main::TIME) > $main::SECONDS_PER_MONTH) {
+ $time = timelocal($sec,$min,$hours,$mday,$mon,$year - 1);
+ }
+
+ }
+
+ # check that the result is reasonable.
+
+ if ( (($main::TIME - $main::SECONDS_PER_YEAR) > $time) ||
+ (($main::TIME + $main::SECONDS_PER_MONTH) < $time) ) {
+ undefine $time;
+ }
+
+ return $time;
+}
+
+# turn a time() into a string time of the form "04/26 15:48".
+
+sub time2timestring {
+ my ($time) = @_;
+
+ my ($sec,$min,$hour,$mday,$mon,
+ $year,$wday,$yday,$isdst) =
+ localtime($time);
+
+ $mon++;
+ $year += 1900;
+ my $display_time = sprintf("%02u/%02u %02u:%02u",
+ $mon, $mday, $hour, $min);
+
+ return $display_time;
+}
+
+
+sub get_params {
+
+ $SIG{'__DIE__'} = \&fatal_error;
+
+ $REMOTE_HOST = remote_host();
+ $TREE = param("tree");
+ (TreeData::tree_exists($TREE)) ||
+ die("tree: $TREE does not exist\n");
+
+ # tree is safe, untaint it.
+ $TREE =~ m/(.*)/;
+ $TREE = $1;
+
+ $MAILADDR = ( param("mailaddr") ||
+ cookie(-name=>"tinderbox_mailaddr"));
+
+ if (param("effectivetime")) {
+ $EFFECTIVE_TIME = timestring2time( param("effectivetime") );
+
+ # allow people to backdate notices but not forward date them.
+ if ($EFFECTIVE_TIME > $TIME) {
+ $EFFECTIVE_TIME = $TIME;
+ }
+ } else {
+ $EFFECTIVE_TIME = time();
+ }
+
+ $MAILADDR = main::extract_user($MAILADDR);
+
+ $USE_COOKIE = param("use_cookie");
+ ($USE_COOKIE) &&
+ ($USE_COOKIE = 1);
+
+ $REMOTE_HOST = remote_host();
+
+ $NOTE=param("note");
+
+ # Remove any known "bad" tags. Since any user can post notices we
+ # have to prevent bad scripts from being posted.
+
+ $NOTE = extract_html_chars($NOTE);
+
+ {
+ TinderDB::loadtree_db($TREE);
+
+ @ASSOCIATIONS = TinderDB::notice_association($TREE);
+ }
+
+ @CHOSEN_ASSOCIATIONS = param("associations");
+
+ return 1;
+}
+
+
+
+
+sub format_input_page {
+ my ($tree) = @_;
+
+ my (@out);
+
+ my ($title) = "Add a Notice to tree: $tree";
+
+
+ my ($sec,$min,$hour,$mday,$mon,
+ $year,$wday,$yday,$isdst) =
+ localtime($EFFECTIVE_TIME);
+ $mon++;
+ $year += 1900;
+ my $display_effective_time = sprintf("%02u/%02u %02u:%02u",
+ $mon, $mday, $hour, $min);
+
+ push @out, (
+ start_html(-title=>$title),
+ h2($title),
+ start_form,
+ );
+
+ push @out, (
+ HTMLPopUp::Link(
+ "linktxt"=>"Return to tree: $tree",
+ "href"=> FileStructure::get_filename($tree, 'tree_URL').
+ "/$FileStructure::DEFAULT_HTML_PAGE",
+ ).
+ p());
+
+ push @out, (
+ "Email address: ",p(),
+ textfield(-name=>'mailaddr',
+ -default=>$MAILADDR),
+ p(),
+ checkbox( -label=>"remember mail address as a cookie",
+ -name=>"use_cookie"),
+ p(),
+ );
+
+ push @out, (
+ "Effective Time: \n",p(),
+ textarea(-name=>'effectivetime',
+ -default=>$display_effective_time,
+ -rows=>1, -cols=>20, -wrap=>'physical',),
+ p(),
+ );
+
+ if (@ASSOCIATIONS) {
+
+ push @out, (
+ h3("Associated with"),
+ p(),
+ checkbox_group(
+ -name=>'associations',
+ -value=>[@ASSOCIATIONS],
+ # -default=>,
+ ),
+ p(),
+ );
+ } # end if
+
+ push @out, (
+ "Enter Notice: \n",p(),
+ textarea(-name=>'note',
+ -rows=>10, -cols=>30, -wrap=>'physical',),
+ p(),
+ );
+
+ push @out, (
+ submit(-name=>'Submit'),
+ p(),
+ );
+
+ # We need the post operation to remember all the parameters which
+ # were passed as arguments as well as those passed as form
+ # variables.
+
+ foreach $param ( param() ) {
+ push @out, hidden($param)."\n";
+ }
+
+
+ push @out, end_form;
+
+ push @out, "\n\n\n";
+
+ return @out;
+}
+
+
+
+
+sub save_note {
+ my ($tree) = @_;
+
+ my (@out);
+
+ my ($localtime) = localtime($EFFECTIVE_TIME);
+
+ my %association;
+ foreach $association (@CHOSEN_ASSOCIATIONS) {
+ $association{$association} = 1;
+ }
+
+ # We embed the IP address of the host, just in case there is some bad
+ # html in the notice that gets through our defenses. If we know that
+ # there is a problem with a page, then we know which machine it came
+ # from.
+
+ my ($record) = {
+ 'tree' => $TREE,
+ 'mailaddr' => $MAILADDR,
+ 'note' => $NOTE,
+ 'time' => $EFFECTIVE_TIME,
+ 'localtime' => $localtime,
+ 'posttime' => $TIME,
+ 'localposttime' => $LOCALTIME,
+ 'remote_host' => $REMOTE_HOST,
+ 'associations' => \%association,
+ };
+
+ my ($update_file) = (FileStructure::get_filename($TREE, 'TinderDB_Dir').
+ "/Notice\.Update\.$TIME\.$MAILADDR");
+
+ $update_file =~ s/\@/\./g;
+ $update_file = main::extract_safe_filename($update_file);
+
+ Persistence::save_structure(
+ $record,
+ $update_file
+ );
+
+ push @out, "posted notice: \n",p().
+ pre($NOTE);
+
+ HTMLPopUp::regenerate_HTML_pages();
+
+ return @out;
+}
+
+
+# save the note to disk and update the cookies
+
+sub make_all_changes {
+ my (@results) = ();
+
+ my $submit = param("Submit");
+
+ if ($submit) {
+ push @results, save_note($TREE);
+
+ if ($USE_COOKIE) {
+ # this must be called before header()
+
+ my ($cookie1,);
+ my ($expires) = 'Sun, 1-Mar-2020 00:00:00 GMT';
+ my ($mailaddr) = param('mailaddr');
+
+ $cookie1 = cookie(
+ -name=>"tinderbox_mailaddr",
+ -value=>$mailaddr,
+ -expires => $expires,
+ -path=>'/',
+ );
+ $SET_COOKIES = [$cookie1,];
+ }
+
+ if (@results) {
+ @results = (
+ h2("Update Results"),
+ p()."\n",
+ join (p(), (
+ "Remote host: $REMOTE_HOST\n",
+ "Local Time: $LOCALTIME\n",
+ "Mail Address: $MAILADDR\n",
+ @results,
+ )
+ ),
+ "\n\n",
+ );
+ }
+ }
+
+ return @results;
+}
+
+
+
+
+# Main
+{
+ set_static_vars();
+ get_env();
+ chk_security();
+
+ get_params();
+
+ my (@out) = make_all_changes();
+
+ print header(-cookie=>$SET_COOKIES);
+
+ push @out, format_input_page($TREE);
+
+ print @out;
+
+ print end_html();
+
+ print "\n\n\n";
+
+ exit 0;
+}
diff --git a/cgi-bin/admintree.cgi b/cgi-bin/admintree.cgi
new file mode 100755
index 0000000..58b1ada
--- /dev/null
+++ b/cgi-bin/admintree.cgi
@@ -0,0 +1,659 @@
+#!/usr/bin/perl -T --
+# -*- Mode: perl; indent-tabs-mode: nil -*-
+#
+
+# admintree.cgi - the webform used by administrators to close the
+# tree, set the message of the day and stop build
+# columns from being shown on the default pages.
+
+
+# $Revision: 1.26 $
+# $Date: 2004/08/07 13:12:10 $
+# $Author: kestes%walrus.com $
+# $Source: /cvsroot/mozilla/webtools/tinderbox2/src/bin/admintree.cgi,v $
+# $Name: $
+
+# The contents of this file are subject to the Mozilla Public
+# License Version 1.1 (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.
+#
+
+# complete rewrite by Ken Estes for contact info see the
+# mozilla/webtools/tinderbox2/Contact file.
+# Contributor(s):
+
+
+
+# Standard perl libraries
+use File::Basename;
+use CGI ':standard';
+
+# Tinderbox libraries
+
+use lib '/srv/tinderbox/local_conf',
+ '/srv/tinderbox/default_conf',
+ '/srv/tinderbox/lib';
+
+ # '/home/ooweb/mozilla/webtools/tinderbox2/./build/local_conf',
+ # '/home/ooweb/mozilla/webtools/tinderbox2/./build/default_conf',
+ # '/home/ooweb/mozilla/webtools/tinderbox2/./build/lib';
+
+use TinderConfig;
+use TreeData;
+use FileStructure;
+use Persistence;
+use TinderHeader;
+use Utils;
+use HTMLPopUp;
+
+
+# Normally we filter user input for 'tainting' and to prevent this:
+
+# http://www.ciac.org/ciac/bulletins/k-021.shtml
+
+# When a victim with scripts enabled in their browser reads this
+# message, the malicious code may be executed
+# unexpectedly. Scripting tags that can be embedded in this way
+# include <SCRIPT>, <OBJECT>, <APPLET>, and <EMBED>.
+
+# note that we want some tags to be allowed (href) but not #
+# others. This requirement breaks the taint perl mechanisms for #
+# checking as we can not escape every '<>'.
+
+# However we trust our administrators not to put bad things in the web
+# pages and we wish to allow them to embed scripts.
+
+
+sub get_params {
+
+ $TREE = param("tree");
+ (TreeData::tree_exists($TREE)) ||
+ die("tree: $TREE does not exist\n");
+
+ # tree is safe, untaint it.
+ $TREE =~ m/(.*)/;
+ $TREE = $1;
+
+ $MAILADDR = ( param("mailaddr") ||
+ cookie(-name=>"tinderbox_mailaddr"));
+ $MAILADDR = main::extract_user($MAILADDR);
+
+ $NEW_BANNER = param("banner");
+ $NEW_BANNER = extract_printable_chars($NEW_BANNER);
+
+ $NEW_MOTD = param("motd");
+ $NEW_MOTD = extract_printable_chars($NEW_MOTD);
+
+ $NEW_TREE_STATE = param("tree_state");
+ $NEW_TREE_STATE = extract_printable_chars($NEW_TREE_STATE);
+
+ $NEW_ADMIN = param("newadmin");
+ $NEW_ADMIN = extract_printable_chars($NEW_ADMIN);
+
+ $USE_COOKIE = param("use_cookie");
+ ($USE_COOKIE) &&
+ ($USE_COOKIE = 1);
+
+ $PASSWD = ( param("passwd") ||
+ cookie(-name=>"tinderbox_password_$TREE"));
+
+ $NEW_PASSWD1 = param('newpasswd1');
+ $NEW_PASSWD2 = param('newpasswd2');
+
+ @NEW_IGNORE_BUILDS = param("ignore_builds");
+ @NEW_IGNORE_BUILDS = uniq(@NEW_IGNORE_BUILDS);
+
+ $REMOTE_HOST = remote_host();
+
+ $ADMINISTRATIVE_NETWORK_PAT = ($TinderConfig::ADMINISTRATIVE_NETWORK_PAT ||
+ '.*');
+
+ return ;
+}
+
+
+
+sub setup_environment {
+
+ $CURRENT_TREE_STATE = TinderHeader::gettree_header('TreeState', $TREE);
+
+ @CURRENT_IGNORE_BUILDS = get_current_ignore_builds($TREE);
+
+ $CURRENT_BANNER = TinderHeader::gettree_header('Banner', $TREE);
+
+ $CURRENT_MOTD = TinderHeader::gettree_header('MOTD', $TREE);
+
+ get_passwd_table();
+
+ return ;
+}
+
+
+
+
+sub encrypt_passwd {
+ my ($passwd) = @_;
+
+ # The man page for Crypt says:
+
+ # KEY is the input string to encrypt, for instance, a user's
+ # typed password. Only the first eight characters are used; the
+ # rest are ignored.
+
+ my $salt = 'aa';
+ my $encoded = crypt($passwd, $salt);
+
+ return $encoded;
+}
+
+
+
+sub get_passwd_table {
+
+ my ($file) = FileStructure::get_filename($TREE, 'passwd');
+
+ (-r $file) ||
+ return ;
+
+ my ($r) = Persistence::load_structure($file);
+ $PASSWD_TABLE{$TREE} = $r;
+
+ return ;
+}
+
+
+
+# peek inside TinderDB::Build to get the names of the builds for this
+# tree
+
+sub get_build_names {
+ my ($tree) = @_;
+ my (@build_names);
+
+ # we need an eval since the builds may not be configured
+
+ eval {
+ local $SIG{'__DIE__'} = sub { };
+
+ use TinderDB::Build;
+
+ my ($build_obj) = TinderDB::Build->new();
+
+ $build_obj->loadtree_db($tree);
+
+ @build_names = TinderDB::Build::all_build_names($tree);
+ };
+
+ return @build_names;
+}
+
+
+
+sub get_current_ignore_builds {
+ my ($tree) = @_;
+ my (@ignore_builds) = ();
+
+ @ignore_builds = split(
+ /,/,
+ TinderHeader::gettree_header('IgnoreBuilds', $TREE)
+ );
+
+ @ignore_builds = uniq(@ignore_builds);
+
+ # It is possible that the current ignore_builds for this tree are
+ # not a subset of the current settings of buildnames, since the
+ # two are not maintained together. Remove settings which no
+ # longer apply.
+
+ my (@build_names) = get_build_names($tree);
+
+ my ($pat) = '';
+
+ foreach $build_name (@build_names) {
+ # careful some buildnames may have '()' or
+ # other metacharacters in them.
+
+ $pat .= "\^". quotemeta($build_name)."\$".
+ "\|";
+ }
+ chop $pat;
+
+ @ignore_builds = grep(/$pat/, @ignore_builds);
+
+
+ return @ignore_builds;
+}
+
+
+
+
+sub format_input_page {
+ my ($tree)= @_;
+ my (@build_names) = get_build_names($tree);
+ my (@tree_states) = $TinderHeader::NAMES2OBJS{'TreeState'}->
+ get_all_sorted_setable_tree_states();
+
+ my ($title) = "Tinderbox Adminstration for Tree: $tree";
+ my (@out);
+
+ my $passwd_string = '';
+ if ( !(keys %{ $PASSWD_TABLE{$TREE} }) ) {
+ $passwd_string = h3(font({-color=>'red'},
+ "No administrators set, ".
+ "no passwords needed."));
+ }
+
+ push @out, (
+ start_html(-title=>$title),
+ h2({-align=>'CENTER'},
+ $title),
+ start_form
+ );
+
+ push @out, (
+ HTMLPopUp::Link(
+ "linktxt"=>"Return to tree: $tree",
+ "href"=> FileStructure::get_filename($tree, 'tree_URL').
+ "/$FileStructure::DEFAULT_HTML_PAGE",
+ ).
+ p());
+
+ push @out, (
+
+ # if we know mailaddr send it back as the default to
+ # show we know the user, do not bother to send the
+ # passwd back in the form.
+
+ h3("Login",),
+ $passwd_string,
+ "Email address: ",
+ textfield(-name=>'mailaddr',
+ -default=>$MAILADDR,
+ -size=>30,),
+ "Password: ".
+ password_field(-name=>'passwd', -size=>8,),
+ p(),
+ checkbox( -label=>("If correct, ".
+ "remember password and email field ".
+ "as a cookie"),
+ -name=>'use_cookie'),
+ p(),
+ );
+
+ push @out, (
+ h3("Change Password",),
+ "Enter the new password twice: <br>\n",
+ "(Only the first eight characters are significant)<p>\n",
+ p(),
+ password_field(-name=>'newpasswd1', -size=>8,),
+ password_field(-name=>'newpasswd2', -size=>8,),
+ p(),
+ );
+
+ push @out, (
+ h3("Add New Administrator",),
+ "Enter the new administrators Email Address: <br>\n",
+ "(default password will be same as administrators name)<p>\n",
+ p(),
+ textfield(-name=>'newadmin', -size=>30,),
+ p(),
+ );
+
+ if (@tree_states) {
+
+ push @out, (
+ h3("Tree State"),
+ "Change the State of the Tree:",
+ p(),
+ radio_group(-name=>'tree_state',
+ -value=>[@tree_states],
+ -default=>$CURRENT_TREE_STATE,),
+ p(),
+ )
+ } # end if
+
+ if (@build_names) {
+ push @out, (
+ h3("Unmonitored Builds"),
+ "The set of Builds which will not normally be displayed: ",
+ p(),
+ checkbox_group(-name=>'ignore_builds',
+ -value=>[@build_names],
+ -default=>[@CURRENT_IGNORE_BUILDS],),
+ p(),
+ )
+ } # end if
+
+ push @out, (
+ h3("Banner"),
+ "New Banner, global to all projects (must be valid HTML)",p(),
+ textarea(-name=>'banner', -default=>$CURRENT_BANNER,
+ -rows=>30, -cols=>75, -wrap=>'physical',),
+ p(),
+ );
+
+ push @out, (
+ h3("Message of the Day"),
+ "New Message of the Day (must be valid HTML)",p(),
+ textarea(-name=>'motd', -default=>$CURRENT_MOTD,
+ -rows=>30, -cols=>75, -wrap=>'physical',),
+ p(),
+ );
+
+ push @out, (
+# the default does not work because the tree gets reset to null
+# defaults(-name=>'Defaults',),
+ submit(-name=>'Submit'),
+ p(),
+ );
+
+ # We need the post operation to remember all the parameters which
+ # were passed as arguments as well as those passed as form
+ # variables.
+
+ foreach $param ( param() ) {
+ push @out, hidden($param)."\n";
+ }
+
+
+ push @out, end_form;
+
+ return @out;
+}
+
+
+
+
+
+sub save_passwd_table {
+ my ($file) = FileStructure::get_filename($TREE, 'passwd');
+
+ # We expect tree administration to be a rare event and each change
+ # should be independent and noncontradictory, so we do not worry
+ # about locking during the updates but we make an effort to keep the
+ # updates atomic.
+
+ if ( keys %{ $PASSWD_TABLE{$TREE} } ) {
+ Persistence::save_structure($PASSWD_TABLE{$TREE},$file);
+ }
+
+ return ;
+}
+
+
+
+sub change_passwd {
+ my (@results) = ();
+
+ if (($NEW_PASSWD1) &&
+ ($NEW_PASSWD1 ne $PASSWD ) ) {
+
+ if ($NEW_PASSWD1 eq $NEW_PASSWD2) {
+
+ # we need to reload the password table so that the check against
+ # existing administrators is nearly atomic.
+
+ get_passwd_table();
+
+ my ($new_encoded1) = encrypt_passwd($NEW_PASSWD1);
+ $PASSWD_TABLE{$TREE}{$MAILADDR} = $new_encoded1;
+ save_passwd_table();
+
+ push @results, "Password changed.\n";
+ } else {
+ push @results, ("New passwords do not match, ".
+ "password not changed.\n");
+ }
+
+ }
+
+ return @results;
+}
+
+
+sub add_new_administrator {
+ my (@results) =();
+
+ ($NEW_ADMIN) ||
+ return ;
+
+ ($NEW_ADMIN !~ m!\@!) &&
+ return("New administrator: $NEW_ADMIN does not have an '\@' ".
+ "in the email address.\n");
+
+ # we need to reload the password table so that the check against
+ # existing administrators is nearly atomic.
+
+ get_passwd_table();
+
+ ($PASSWD_TABLE{$TREE}{$NEW_ADMIN}) &&
+ return("New administrator: $NEW_ADMIN already has an account.\n");
+
+
+ $PASSWD_TABLE{$TREE}{$NEW_ADMIN} = encrypt_passwd($NEW_ADMIN);
+ save_passwd_table();
+ push @results, ("Added administrator: $NEW_ADMIN \n".
+ "(default passwd is same as admin name)\n");
+
+ return @results;
+}
+
+
+
+
+
+sub change_tree_state {
+ my (@results) =();
+
+ ($NEW_TREE_STATE) ||
+ return ;
+
+ ($NEW_TREE_STATE eq $CURRENT_TREE_STATE) &&
+ return ;
+
+ TinderHeader::savetree_header('TreeState', $TREE, $NEW_TREE_STATE);
+ push @results, "Tree_State changed: $NEW_TREE_STATE\n";
+
+ return @results;
+}
+
+
+
+sub change_ignore_builds {
+ my (@results) = ();
+ my (@out);
+
+ ("@NEW_IGNORE_BUILDS" eq "@CURRENT_IGNORE_BUILDS") &&
+ return ;
+
+ $ignore_builds = join(',', @NEW_IGNORE_BUILDS);
+ TinderHeader::savetree_header('IgnoreBuilds', $TREE, $ignore_builds);
+
+ push @results, "ignore_builds changed: @NEW_IGNORE_BUILDS \n";
+
+ return @results;
+}
+
+
+
+sub change_banner {
+ my (@results) = ();
+
+ # remember new_motd could be empty. As long as it is different than
+ # old_motd we should save it.
+
+ ($NEW_BANNER eq $CURRENT_BANNER) &&
+ return ;
+
+ TinderHeader::savetree_header('Banner', $TREE, $NEW_BANNER);
+ push @results, "Banner changed: \n\t'\n$NEW_BANNER\n\t' \n";
+
+ return @results;
+}
+
+
+sub change_motd {
+ my (@results) = ();
+
+ # remember new_motd could be empty. As long as it is different than
+ # old_motd we should save it.
+
+ ($NEW_MOTD eq $CURRENT_MOTD) &&
+ return ;
+
+ TinderHeader::savetree_header('MOTD', $TREE, $NEW_MOTD);
+ push @results, "MOTD changed: \n\t'\n$NEW_MOTD\n\t' \n";
+
+ return @results;
+}
+
+
+
+# return empty if there is no security problem otherwise return a list
+# of strings explaining the problem
+
+sub security_problem {
+ my (@out) = ();
+
+ ($REMOTE_HOST =~ m!$ADMINISTRATIVE_NETWORK_PAT!) ||
+ (push @out, ("Error, Host: '$REMOTE_HOST' not valid. ".
+ " Requests must be made from an IP address".
+ " in an administrative network.\n"));
+
+ # If they are not on a valid network they should not see what our
+ # other security checks are.
+
+ scalar(@out) &&
+ return @out;
+
+ ($MAILADDR) ||
+ (push @out, "Error, No Mail Address\n");
+
+ ($MAILADDR =~ m!\@!) ||
+ (push @out, "Error, Mail Address must have '\@' in it.\n");
+
+ if ( keys %{ $PASSWD_TABLE{$TREE}} ) {
+ ($PASSWD) ||
+ (push @out, "Error, must enter Password\n");
+
+ my ($encoded) = encrypt_passwd($PASSWD);
+
+ ($encoded eq $PASSWD_TABLE{$TREE}{$MAILADDR}) ||
+ (push @out, "Error, Password Not Valid\n");
+ }
+
+ return @out;
+}
+
+
+
+# perform all the updates which have been requested.
+
+sub make_all_changes {
+ my (@results) = ();
+
+ my $submit = param("Submit");
+
+ if ($submit) {
+ @results = security_problem();
+ my ($security_problems) = scalar(@results);
+
+ if (!($security_problems)) {
+ push @results, change_passwd();
+ push @results, add_new_administrator();
+ push @results, change_tree_state();
+ push @results, change_ignore_builds();
+ push @results, change_motd();
+ push @results, ("Check changes are correct on the status page, ".
+ "different administrators can change ".
+ "the settings at the same time.");
+
+ HTMLPopUp::regenerate_HTML_pages();
+
+ } else {
+ push @results, "No changes attempted due to security issues.";
+ }
+
+ if ( ($USE_COOKIE) && (!($security_problems)) ) {
+ # this must be called before header()
+
+ my ($cookie1, $cookie2);
+ my ($expires) = 'Sun, 1-Mar-2020 00:00:00 GMT';
+ my ($passwd) = param('passwd');
+ my ($mailaddr) = param('mailaddr');
+
+ $cookie1 = cookie(
+ -name=>"tinderbox_password_$TREE",
+ -value=>$passwd,
+ -expires => $expires,
+ -path=>'/',
+ );
+ $cookie2 = cookie(
+ -name=>"tinderbox_mailaddr",
+ -value=>$mailaddr,
+ -expires => $expires,
+ -path=>'/',
+ );
+ $SET_COOKIES = [$cookie1, $cookie2];
+ }
+
+ if (@results) {
+ @results = (
+ h2("Update Results"),
+ p()."\n",
+ join (p(), (
+ "Remote host: $REMOTE_HOST\n",
+ "Local Time: $LOCALTIME\n",
+ "Mail Address: $MAILADDR\n",
+ @results,
+ )
+ ),
+ "\n\n",
+ );
+ log_warning(@results);
+ }
+ }
+
+ return @results;
+}
+
+
+
+
+# Main
+{
+ set_static_vars();
+ get_env();
+ chk_security();
+
+ get_params();
+
+ setup_environment();
+
+ my (@out) = make_all_changes();
+
+ print header(-cookie=>$SET_COOKIES);
+
+ push @out, format_input_page($TREE);
+
+ print @out;
+
+ print end_html();
+
+ print "\n\n\n";
+
+ exit 0;
+}
diff --git a/cgi-bin/bustagestats.cgi b/cgi-bin/bustagestats.cgi
new file mode 100755
index 0000000..5247029
--- /dev/null
+++ b/cgi-bin/bustagestats.cgi
@@ -0,0 +1,124 @@
+#!/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';
+
+use Date::Parse;
+use Date::Format;
+
+my $TIMEFORMAT = "%D %T";
+
+$|=1;
+
+print "Content-type: text/html\n\n<HTML>\n";
+
+# &load_data;
+
+EmitHtmlHeader("Statistics");
+
+my $tree = $form{'tree'};
+my $start = $form{'start'};
+my $end = $form{'end'};
+
+sub str2timeAndCheck {
+ my ($str) = (@_);
+ my $result = str2time($str);
+ if (defined $result && $result > 7000000) {
+ return $result;
+ }
+ print "<p><font color=red>Can't parse as a date: $str</font><p>\n";
+ return 0;
+}
+
+if (defined $tree && defined $start && defined $end) {
+ my $first = str2timeAndCheck($start);
+ my $last = str2timeAndCheck($end);
+ if ($first > 0 && $last > 0) {
+ if (open(IN, "<$tree/build.dat")) {
+ print "<hr><center><h1>Bustage stats for $tree</H1><H3>from " .
+ time2str($TIMEFORMAT, $first) . " to " .
+ time2str($TIMEFORMAT, $last) . "</H3></center>\n";
+ my %stats;
+ while (<IN>) {
+ chomp;
+ my ($mailtime, $buildtime, $buildname, $errorparser,
+ $buildstatus, $logfile, $binaryname) =
+ split( /\|/ );
+ if ($buildtime >= $first && $buildtime <= $last) {
+ if (!defined $stats{$buildname}) {
+ $stats{$buildname} = 0;
+ }
+ if ($buildstatus eq "busted") {
+ $stats{$buildname}++;
+ }
+ }
+ }
+ print "<table>\n";
+ print "<tr><th>Build name</th><th>Number of bustages</th></tr>\n";
+ foreach my $key (sort (keys %stats)) {
+ print "<tr><td>$key</td><td>$stats{$key}</td></tr>\n";
+ }
+ print "</table>\n";
+ } else {
+ print "<p><font color=red>There does not appear to be a tree " .
+ "named '$tree'.</font><p>";
+ }
+
+ }
+ print "<hr>\n";
+}
+
+if (!defined $tree) {
+ $tree = "";
+}
+
+if (!defined $start) {
+ $start = time2str($TIMEFORMAT, time() - 7*24*60*60); # One week ago.
+}
+
+if (!defined $end) {
+ $end = time2str($TIMEFORMAT, time()); # #now
+}
+
+
+print qq|
+<form>
+<table>
+<tr>
+<th align=right>Tree:</th>
+<td><input name=tree size=30 value="$tree"></td>
+</tr>
+<tr>
+<th align=right>Start time:</th>
+<td><input name=start size=30 value="$start"></td>
+</tr>
+<tr>
+<th align=right>End time:</th>
+<td><input name=end size=30 value="$end"></td>
+</tr>
+</table>
+
+<INPUT TYPE=\"submit\" VALUE=\"Generate stats \">
+
+</form>
+|;
diff --git a/cgi-bin/cvsquery.cgi b/cgi-bin/cvsquery.cgi
new file mode 100644
index 0000000..d5a7da8
--- /dev/null
+++ b/cgi-bin/cvsquery.cgi
@@ -0,0 +1,701 @@
+#!/usr/bin/perl -w
+# -*- Mode: perl; indent-tabs-mode: nil -*-
+#
+# The contents of this file are subject to the Netscape Public
+# License Version 1.1 (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.
+#
+# Contributor(s):
+
+use diagnostics;
+use strict;
+
+# Shut up misguided -w warnings about "used only once". "use vars" just
+# doesn't work for me.
+
+sub sillyness {
+ my $zz;
+ $zz = $::CI_BRANCH;
+ $zz = $::CI_REPOSITORY;
+ $zz = $::CI_CHANGE;
+ $zz = $::CI_STICKY;
+ $zz = $::lines_added;
+ $zz = $::lines_removed;
+ $zz = $::query_begin_tag;
+ $zz = $::query_branchtype;
+ $zz = $::query_date_max;
+ $zz = $::query_debug;
+ $zz = $::query_end_tag;
+ $zz = $::query_filetype;
+ $zz = $::query_logexpr;
+ $zz = $::query_whotype;
+ $zz = $::script_type;
+}
+
+
+
+require 'CGI.pl';
+require 'data/treeconfig.pl';
+require 'pvcs_query_checkins.pl';
+
+#require 'cvsquery.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;
+
+my $NOT_LOCAL = 1;
+my $IS_LOCAL = 2;
+
+$::CVS_ROOT = '/';
+my $userdomain = Param('userdomain');
+my $registryurl = Param('registryurl');
+$registryurl =~ s@/$@@;
+$| = 1;
+
+my $sm_font_tag = "<font face='Arial,Helvetica' size=-2>";
+
+my $generateBackoutCVSCommands = 0;
+if (defined $::FORM{'generateBackoutCVSCommands'}) {
+ $generateBackoutCVSCommands = 1;
+}
+
+if (!$generateBackoutCVSCommands) {
+ print "Content-type: text/html
+
+";
+
+ print setup_script();
+}
+
+#print "<pre>";
+
+
+my $SORT_HEAD="bgcolor=\"#DDDDDD\"";
+
+#
+# Log the query
+Log("Query [$ENV{'REMOTE_ADDR'}]: $ENV{'QUERY_STRING'}");
+
+#
+# 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
+#
+$::FORM{'file'} = "" unless defined $::FORM{'file'};
+unless ($::FORM{'dir'}) {
+ $::FORM{'file'} = Fix_BonsaiLink($::FORM{'file'});
+ if ($::FORM{'file'} =~ m@(.*?/)([^/]*)$@) {
+ $::FORM{'dir'} = $1;
+ $::FORM{'file'} = $2;
+ } else {
+ $::FORM{'dir'} = "";
+ }
+}
+
+#
+# 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'}) {
+ $::query_date_min = parse_date($::FORM{'mindate'});
+ }
+
+ if ($::FORM{'maxdate'}) {
+ $::query_date_max = parse_date($::FORM{'maxdate'});
+ }
+}
+else {
+ $::query_date_min = time-60*60*2;
+}
+
+#
+# who
+#
+$::query_who = $::FORM{'who'};
+$::query_whotype = $::FORM{'whotype'};
+
+
+my $show_raw = 0;
+if ($::FORM{'raw'}) {
+ $show_raw = 1;
+}
+
+#
+# branch
+#
+$::query_branch = $::FORM{'branch'};
+if (!defined $::query_branch) {
+ $::query_branch = 'HEAD';
+}
+$::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.
+#
+my ($t, $e);
+$t = $e = &query_to_english;
+$t =~ s/<[^>]*>//g;
+
+$::query_debug = $::FORM{'debug'};
+
+my %mod_map = ();
+my $result= &query_checkins( %mod_map );
+
+my %w;
+
+for my $i (@{$result}) {
+ my $aname=$i->[$::CI_WHO];
+# the else is for compatibility w/ something that uses the other format
+# the regexp is probably not the best, but I think it might work
+ if ($aname =~ /%\w*.\w\w+/) {
+ my $tmp = join("@",split("%",$aname));
+ $w{"$tmp"} = 1;
+ }else{
+ $w{"$i->[$::CI_WHO]\@$userdomain"} = 1;
+ }
+}
+
+my @p = sort keys %w;
+my $pCount = @p;
+my $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>
+";
+if ($pCount) {
+ $menu .= "
+<br><a href=mailto:$s>Mail everyone on this page</a>
+<NOBR>($pCount people)</NOBR>
+";
+}
+
+if (defined $::FORM{'generateBackoutCVSCommands'}) {
+ print "Content-type: text/plain
+
+# This page can be saved as a shell script and executed. It should be
+# run at the top of your CVS work area. It will update your workarea to
+# backout the changes selected by your query.
+
+";
+ unless ($pCount) {
+ print "
+#
+# No changes occurred during this interval.
+# There is nothing to back out.
+#
+
+";
+ exit;
+ }
+
+ foreach my $ci (reverse @{$result}) {
+ if ($ci->[$::CI_REV] eq "") {
+ print "echo 'Changes made to $ci->[$::CI_DIR]/$ci->[$::CI_FILE] need to be backed out by hand'\n";
+ next;
+ }
+ my $prev_revision = PrevRev($ci->[$::CI_REV]);
+ print "cvs update -j$ci->[$::CI_REV] -j$prev_revision $ci->[$::CI_DIR]/$ci->[$::CI_FILE]\n";
+ }
+ exit;
+}
+
+
+PutsHeader($t, "PVCS Checkins", "$menu");
+
+#
+# Test code to print the results
+#
+
+$|=1;
+
+my $head_who = '';
+my $head_file = '';
+my $head_directory = '';
+my $head_delta = '';
+my $head_date = '';
+
+if( !$show_raw ) {
+
+ $::FORM{"sortby"} ||= "";
+
+ 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 my $ci (@$result) {
+ $ci->[$::CI_LOG] = '';
+ $s = join("|",@$ci);
+ print "$s\n";
+ }
+}
+
+#
+#
+#
+sub print_result {
+ my ($result) = @_;
+ my ($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 consecutive 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;
+}
+
+my $descwidth;
+
+sub print_ci {
+ my ($ci, $span) = @_;
+
+ my ($sec,$minute,$hour,$mday,$mon,$year) = localtime( $ci->[$::CI_DATE] );
+ my $t = sprintf("%02d/%02d/%04d %02d:%02d",$mon+1,$mday,$year+1900,$hour,$minute);
+
+ my $log = &html_log($ci->[$::CI_LOG]);
+ my $rev = $ci->[$::CI_REV];
+ my $url_who = url_quote($ci->[$::CI_WHO]);
+
+ print "<tr>\n";
+
+# my $slash ='%2F';
+# my $colon ='%3A';
+# my $space ='%20';
+# my $url_t = sprintf("%02d%$slash%02d%$slash%04d%$space%02d%$colon%02d%$colon%02d",
+# $mon+1,$mday,$year+1900,
+# $hour,$minute,0);
+#
+# my $t_anchor = $ENV{QUERY_STRING};
+# $t_anchor =~ s/\&mindate\=[A-Za-z0-9\%\ \+]*//g;
+# $t_anchor =~ s/\&date\=[A-Za-z0-9\%\ \+]*//g;
+# $t_anchor = "<a href=cvsquery.cgi?$anchor&date=explicit&mindate=$url_t>$t</a>\n";
+
+ print "<TD width=2%>${sm_font_tag}$t</font>\n";
+ print "<TD width=2%><a href='$registryurl/who.cgi?email=$url_who'"
+ . " onClick=\"return js_who_menu('$url_who','',event);\" >"
+ . "$ci->[$::CI_WHO]</a>\n";
+ print "<TD width=45%>\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>  /;
+# # Insert a <BR> before any directory named
+# # 'classes.'
+# }
+# print " $d/<br> $ci->[$::CI_FILE]<a>\n";
+# }
+# else{
+# print " $ci->[$::CI_DIR]/$ci->[$::CI_FILE]<a>\n";
+# }
+ my $d = "$ci->[$::CI_DIR]/$ci->[$::CI_FILE]";
+ if (defined $::query_module && $::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 '' ){
+ my $prevrev = &PrevRev( $rev );
+ print "<TD width=2%>${sm_font_tag}$rev</font>\n";
+ }
+ else {
+ print "<TD width=2%>\ \n";
+ }
+
+ if( !$::query_branch_head ){
+ my $branch = $ci->[$::CI_BRANCH];
+
+ my $anchor = $ENV{QUERY_STRING};
+ $anchor =~ s/\&branch\=[A-Za-z\ \+]*//g;
+ $anchor = "<a href=cvsquery.cgi?$anchor&branch=$branch>$branch</a>\n";
+
+ print "<TD width=2%><TT><FONT SIZE=-1>$anchor</FONT></TT> \n";
+ }
+
+ if( defined($log) && ($log ne '') ){
+ $log = MarkUpText($log);
+ # Makes numbers into links to bugsplat.
+
+ $log =~ s/\n/<BR>/g;
+ # Makes newlines into <BR>'s
+
+ if( $span > 1 ){
+ print "<TD WIDTH=$descwidth% VALIGN=TOP ROWSPAN=$span>$log\n";
+ }
+ else {
+ print "<TD WIDTH=$descwidth% VALIGN=TOP>$log\n";
+ }
+ }
+ print "</tr>\n";
+}
+
+sub print_head {
+
+if ($::versioninfo) {
+ print "<FORM action='multidiff.cgi' method=post>";
+ 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.";
+}
+
+my $anchor = $ENV{QUERY_STRING};
+$anchor =~ s/\&sortby\=[A-Za-z\ \+]*//g;
+$anchor = "<a href=cvsquery.cgi?$anchor";
+
+print "<TABLE border cellspacing=2>\n";
+print "<b><TR ALIGN=LEFT>\n";
+print "<TH width=2% $head_date>$anchor>When</a>\n";
+print "<TH width=2% $head_who>${anchor}&sortby=Who>Who</a>\n";
+print "<TH width=45% $head_file>${anchor}&sortby=File>File</a>\n";
+print "<TH width=2%>Rev\n";
+
+$descwidth = 47;
+if( !$::query_branch_head ){
+ print "<TH width=2%>WorkSet\n";
+ $descwidth -= 2;
+}
+
+print "<TH WIDTH=$descwidth%>Description\n";
+print "</TR></b>\n";
+}
+
+
+sub print_foot {
+ print "</TABLE>";
+ print "<br><br>";
+}
+
+sub html_log {
+ my ( $log ) = @_;
+ $log =~ s/&/&/g;
+ $log =~ s/</</g;
+ return $log;
+}
+
+sub PrevRev {
+ my( $rev ) = @_;
+ # PVCS uses different version numberings
+ return ($rev - 1);
+ my( $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 {
+
+ my $script_str = qq{
+<script $::script_type><!--
+var event = 0; // Nav3.0 compatibility
+
+function js_who_menu(n,extra,d) {
+ if( parseInt(navigator.appVersion) < 4 ||
+ navigator.userAgent.toLowerCase().indexOf("msie") != -1 ){
+ return true;
+ }
+ l = document.layers['popup'];
+ l.src="$registryurl/who.cgi?email="+n+extra;
+
+ if(d.target.y > window.innerHeight + window.pageYOffset - l.clip.height) {
+ l.top = (window.innerHeight + window.pageYOffset - l.clip.height);
+ } else {
+ l.top = d.target.y - 6;
+ }
+ l.left = d.target.x - 6;
+
+ l.visibility="show";
+ return false;
+}
+
+function js_file_menu(repos,dir,file,rev,branch,d) {
+ var fileName="";
+ if( parseInt(navigator.appVersion) < 4 ||
+ navigator.userAgent.toLowerCase().indexOf("msie") != -1 ){
+ return true;
+ }
+ for (var i=0;i<d.target.text.length;i++)
+ {
+ if (d.target.text.charAt(i)!=" ") {
+ fileName+=d.target.text.charAt(i);
+ }
+ }
+ l = document.layers['popup'];
+ l.src="$registryurl/file.cgi?cvsroot="+repos+"&file="+file+"&dir="+dir+"&rev="+rev+"&branch="+branch+"&linked_text="+fileName;
+
+ 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>
+
+};
+
+ return $script_str;
+}
+
+#
+# Actually do the query
+#
+sub query_to_english {
+ my $english = 'Checkins ';
+
+ $::query_module = 'all' unless defined $::query_module;
+ if( $::query_module eq 'allrepositories' ){
+ $english .= "to <i>All Repositories</i> ";
+ }
+ elsif( $::query_module ne 'all' && @::query_dirs == 0 ){
+ $english .= "to product_id <i>" . html_quote($::query_module) . "</i> ";
+ }
+ elsif( $::FORM{dir} ne "" ) {
+ my $word = "directory";
+ if (@::query_dirs > 1) {
+ $word = "directories";
+ }
+ $english .= "to $word <i>" . html_quote($::FORM{dir}) . "</i> ";
+ }
+
+ if ($::query_file ne "") {
+ if ($english ne 'Checkins ') {
+ $english .= "and ";
+ }
+ $english .= "to file " . html_quote($::query_file) . " ";
+ }
+
+ if( ! ($::query_branch =~ /^[ ]*HEAD[ ]*$/i) ){
+ if($::query_branch eq '' ){
+ $english .= "on all branches ";
+ }
+ else {
+ $english .= "on branch <i>" . html_quote($::query_branch) . "</i> ";
+ }
+ }
+
+ if( $::query_who) {
+ $english .= "by " . html_quote($::query_who) . " ";
+ }
+
+ $::query_date_type = $::FORM{'date'};
+ if( $::query_date_type eq 'hours' ){
+ $english .="in the last " . html_quote($::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' ){
+ my ($w1, $w2);
+ if ( $::FORM{mindate} && $::FORM{maxdate}) {
+ $w1 = "between";
+ $w2 = "and" ;
+ }
+ else {
+ $w1 = "since";
+ $w2 = "before";
+ }
+
+ if( $::FORM{'mindate'}){
+ my $dd = &parse_date($::FORM{'mindate'});
+ my ($sec,$minute,$hour,$mday,$mon,$year) = localtime( $dd );
+ my $t = sprintf("%02d/%02d/%04d %02d:%02d",$mon+1,$mday,$year+1900,$hour,$minute);
+ $english .= "$w1 <i>$t</i> ";
+ }
+
+ if( $::FORM{'maxdate'}){
+ my $dd = &parse_date($::FORM{'maxdate'});
+ my ($sec,$minute,$hour,$mday,$mon,$year) = localtime( $dd );
+ my $t = sprintf("%02d/%02d/%04d %02d:%02d",$mon+1,$mday,$year+1900,$hour,$minute);
+ $english .= "$w2 <i>$t</i> ";
+ }
+ }
+ return $english . ":";
+}
+
+PutsTrailer();
diff --git a/cgi-bin/cvsqueryform.cgi b/cgi-bin/cvsqueryform.cgi
new file mode 100644
index 0000000..4f4e57b
--- /dev/null
+++ b/cgi-bin/cvsqueryform.cgi
@@ -0,0 +1,309 @@
+#!/usr/bin/perl -w
+# -*- Mode: perl; indent-tabs-mode: nil -*-
+#
+# The contents of this file are subject to the Netscape Public
+# License Version 1.1 (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.
+#
+# Contributor(s):
+
+# Query the CVS database.
+#
+
+use diagnostics;
+use strict;
+
+require 'CGI.pl';
+require 'pvcs_query_checkins.pl';
+
+$|=1;
+
+print "Content-type: text/html\n\n";
+
+require 'data/treeconfig.pl';
+
+$::modules = {};
+#require 'modules.pl';
+$::CVS_ROOT = '/';
+$::TreeInfo = ();
+
+PutsHeader("Bonsai - CVS_PVCS Query Form", "CVS_PVCS Query Form",
+ "$::CVS_ROOT - $::TreeInfo{$::TreeID}{shortdesc}");
+
+print "
+<p>
+<FORM METHOD=GET ACTION='cvsquery.cgi'>
+<INPUT TYPE=HIDDEN NAME=treeid VALUE=$::TreeID>
+<p>
+<TABLE BORDER CELLPADDING=8 CELLSPACING=0>
+";
+
+
+#
+# module selector
+#
+print "
+<TR><TH ALIGN=RIGHT>Product_ID:</TH>
+<TD>
+<SELECT name='module' size=5>
+";
+
+
+#
+# check to see if there are multiple repositories
+#
+my @reposList = &getRepositoryList();
+my $bMultiRepos = (@reposList > 1);
+
+#
+# This code sucks, I should rewrite it to be shorter
+#
+my $Module = 'default';
+
+if (!exists $::FORM{module} || $::FORM{module} eq 'all' ||
+ $::FORM{module} eq '') {
+ print "<OPTION SELECTED VALUE='all'>All Files in the Repository\n";
+}
+elsif( $::FORM{module} eq 'allrepositories' ){
+ print "<OPTION VALUE='all'>All Files in the Repository\n";
+}
+else {
+ $Module = $::FORM{module};
+ print "<OPTION VALUE='all'>All Files in the Repository\n";
+ my $escaped_module = html_quote($::FORM{module});
+ print "<OPTION SELECTED VALUE='$escaped_module'>$escaped_module\n";
+}
+
+#
+# Print out all the Different Modules
+#
+load_product_id_into_modules();
+for my $k (sort( keys( %$::modules ) ) ){
+ if (defined $::FORM{module} && $k eq $::FORM{module}) {
+ next;
+ }
+ 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>WorkSet_Name:</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
+#
+
+$::FORM{dir} ||= "";
+
+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>
+";
+
+$::FORM{file} ||= "";
+
+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
+#
+
+$::FORM{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
+#
+$::FORM{logexpr} .= '';
+print "
+<tr>
+<th align=right>Log contains:</th>
+<td colspan=2> <input type=text name=logexpr value='$::FORM{logexpr}' size=45><br>
+(you can use <a href=oracleregexp.cgi>regular expressions</a>)
+</td>
+</tr>
+";
+
+
+#
+# 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
+#
+
+if (!defined($::FORM{date}) || $::FORM{date} eq "") {
+ $::FORM{date} = "hours";
+}
+
+$::FORM{mindate} = '' unless defined($::FORM{mindate});
+$::FORM{maxdate} = '' unless defined($::FORM{maxdate});
+
+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 </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/yyyy 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 value='$::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>";
+
+
+PutsTrailer();
+
+sub sortTest {
+ return ""
+ unless (exists($::FORM{sortby}) && defined($_[0]) &&
+ ($_[0] eq $::FORM{sortby}));
+
+ return " SELECTED";
+}
+
+
+sub dateTest {
+ if( $_[0] eq $::FORM{date} ){
+ return " CHECKED value=$_[0]";
+ }
+ else {
+ return "value=$_[0]";
+ }
+}
+
+sub regexpradio {
+ my ($name) = @_;
+ my ($c1, $c2, $c3);
+
+ $c1 = $c2 = $c3 = "";
+
+ my $n = $::FORM{$name} || "";
+
+ if( $n eq 'regexp'){
+ $c2 = "checked";
+ }
+ elsif( $n eq 'notregexp'){
+ $c3 = "checked";
+ }
+ else {
+ $c1 = "checked";
+ }
+ return "
+<input type=radio name=$name value=match $c1>Exact match
+
+<input type=radio name=$name value=regexp $c2><a href=oracleregexp.cgi>Regular expression</a>
+
+<input type=radio name=$name value=notregexp $c3>Doesn't match <a href=oracleregexp.cgi>Reg Exp</a>";
+}
+
+
diff --git a/cgi-bin/gunzip.cgi b/cgi-bin/gunzip.cgi
new file mode 100755
index 0000000..32b9c00
--- /dev/null
+++ b/cgi-bin/gunzip.cgi
@@ -0,0 +1,169 @@
+#!/usr/bin/perl -T --
+# -*- Mode: perl; indent-tabs-mode: nil -*-
+#
+
+# gunzip.cgi - This cgi script will gunzip a file and send the result
+# to standard out in a form that a webserver can display. Filenames
+# are passed in via an abbreviated form. It is assumed that all files
+# are either brief or full log files which are stored in known
+# Tinderbox directories. The file id is the basename of the file
+# without the '.gz.html' extension.
+
+
+# $Revision: 1.11 $
+# $Date: 2003/08/17 00:44:04 $
+# $Author: kestes%walrus.com $
+# $Source: /cvsroot/mozilla/webtools/tinderbox2/src/bin/gunzip.cgi,v $
+# $Name: $
+
+
+
+# The contents of this file are subject to the Mozilla Public
+# License Version 1.1 (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.
+#
+
+# complete rewrite by Ken Estes for contact info see the
+# mozilla/webtools/tinderbox2/Contact file.
+# Contributor(s):
+
+
+
+# Tinderbox libraries
+use lib '/srv/tinderbox/local_conf',
+ '/srv/tinderbox/default_conf',
+ '/srv/tinderbox/lib';
+
+use TinderConfig;
+use TreeData;
+use FileStructure;
+use HTMLPopUp;
+use Utils;
+
+
+
+
+
+
+sub usage {
+
+
+ my $usage =<<EOF;
+
+$0 [--version] [--help]
+$0 tree=treename [brief-log=fileid][full-log=fileid]
+
+
+Informational Arguments
+
+
+--version Print version information for this program
+
+--help Show this usage page
+
+
+Synopsis
+
+
+This cgi script will gunzip a file and send the result to standard out
+in a form that a webserver can display. Filenames are passed in via
+an abbreviated form. It is assumed that all files are either brief or
+full log files which are stored in known Tinderbox directories. The
+file id is the basename of the file without the '.gz.html' extension.
+
+
+EOF
+
+ print $usage;
+ exit 0;
+
+} # usage
+
+
+sub parse_args {
+ my (%form) = HTMLPopUp::split_cgi_args();
+
+ # take care of the informational arguments
+
+ if(grep /version/, keys %form) {
+ print "$0: Version: $VERSION\n";
+ exit 0;
+ }
+
+ if (grep /help/, keys %form) {
+ usage();
+ }
+
+ my ($tree) = $form{'tree'};
+
+ (TreeData::tree_exists($tree)) ||
+ die("tree: $tree does not exist\n");
+
+ # tree is safe, untaint it.
+ $tree =~ m/(.*)/;
+ $tree = $1;
+
+ my ($log_type);
+ my ($log_file);
+ if ($log_file = $form{'brief-log'}) {
+ $log_type = "brief-log";
+ } elsif ($log_file = $form{'full-log'}) {
+ $log_type = "full-log";
+ }
+
+ # untaint the log_file, we do not use letters in the file name yet
+ # but it does us no harm to allow for future expansion.
+
+ $log_file =~ m/([0-9a-zA-Z\.]*)/;
+ $log_file = $1;
+
+ ($log_type) ||
+ die("Must specify either 'full-log' or 'brief-log'\n");
+
+ my ($zipped_file) = (FileStructure::get_filename($tree, $log_type).
+ "/$log_file.html.gz");
+
+ $LOG_TYPE = $log_type;
+ $ZIPPED_FILE = $zipped_file;
+
+ return 1;
+}
+
+
+
+# --------------------main-------------------------
+{
+ set_static_vars();
+ get_env();
+ parse_args();
+ chk_security();
+
+ print "Content-type: text/html\n\n";
+
+ # To ensure that we do not have security problems:
+ # 1) we ensure that the log file exists
+ # 2) we run system with a list argument.
+
+ if (-f $ZIPPED_FILE) {
+ my (@cmd) = (@GUNZIP, $ZIPPED_FILE);
+ system(@cmd);
+ ($?) && die("Could not run: '@cmd' : $! : waitstatus $? \n");
+ } else {
+ print "Could not find file: $ZIPPED_FILE\n";
+ }
+
+ exit 0;
+}
diff --git a/cgi-bin/oracleregexp.cgi b/cgi-bin/oracleregexp.cgi
new file mode 100644
index 0000000..1fb65ff
--- /dev/null
+++ b/cgi-bin/oracleregexp.cgi
@@ -0,0 +1,86 @@
+#!/usr/bin/perl -w
+# -*- Mode: perl; indent-tabs-mode: nil -*-
+#
+# The contents of this file are subject to the Netscape Public
+# License Version 1.1 (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.
+#
+# Contributor(s):
+
+
+
+print "Content-type: text/html\n\n";
+
+$out =<<EOF
+<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_pvcs query tool</TITLE>
+</HEAD>
+<BODY>
+
+<H1>
+Description of Oracle regular expression syntax.</H1>
+Regular expressions are a powerful way of specifying complex searches.
+
+
+<h2>LIKE</h2>
+<p>
+The LIKE predicate provides the only pattern matching capability in SQL for the character data types. It takes the following form
+</p>
+<pre>
+columnname [NOT] LIKE pattern-to-match
+</pre>
+<p>
+The pattern match characters are the percent sign (%) to denote 0 or more arbitrary characters, and the underscore (_) to denote exactly one arbitrary character.
+</p>
+<p>
+
+List the employee numbers and surnames of all employees who have a surname beginning with C.
+</p>
+<pre>
+SELECT empno,surname
+FROM employee
+WHERE surname LIKE 'C%'
+</pre>
+<p>
+List all course numbers and names for any course to do with accounting.
+</p>
+<pre>
+SELECT courseno,cname
+FROM course
+WHERE cname LIKE '%ccount%'
+</pre>
+
+<p>
+List all employees who have r as the second letter of their forename.
+</p>
+<pre>
+SELECT surname, forenames
+FROM employee
+WHERE forenames LIKE '_r%'
+</pre>
+
+
+</BODY>
+</HTML>
+EOF
+;
+
+print $out;
+exit 0;
diff --git a/cgi-bin/regenerate.cgi b/cgi-bin/regenerate.cgi
new file mode 100755
index 0000000..41e904d
--- /dev/null
+++ b/cgi-bin/regenerate.cgi
@@ -0,0 +1,129 @@
+#!/usr/bin/perl -T --
+# -*- Mode: perl; indent-tabs-mode: nil -*-
+#
+
+# regenerate.cgi - the webform used by administrators to close the
+# tree, set the message of the day and stop build
+# columns from being shown on the default pages.
+
+
+# $Revision: 1.17 $
+# $Date: 2004/07/18 18:37:46 $
+# $Author: kestes%walrus.com $
+# $Source: /cvsroot/mozilla/webtools/tinderbox2/src/bin/regenerate.cgi,v $
+# $Name: $
+
+# The contents of this file are subject to the Mozilla Public
+# License Version 1.1 (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.
+#
+
+# complete rewrite by Ken Estes for contact info see the
+# mozilla/webtools/tinderbox2/Contact file.
+# Contributor(s):
+
+
+
+# Standard perl libraries
+
+# Tinderbox libraries
+
+use lib '/srv/tinderbox/local_conf',
+ '/srv/tinderbox/default_conf',
+ '/srv/tinderbox/lib';
+
+use TinderConfig;
+use TreeData;
+use Utils;
+use HTMLPopUp;
+use FileStructure;
+
+
+
+# Main
+{
+ # must call set_static_vars() to ensure that we are taint safe.
+ set_static_vars();
+
+ my (%form) = HTMLPopUp::split_cgi_args(
+ 'cgi_remove_args' => ['daemon-mode'],
+ );
+
+ my ($tree) = $form{'tree'};
+ my ($out) = '';
+
+ if (defined($tree)) {
+ # called from a tinderbox web page.
+ # send them back to the status page.
+
+ my ($url) = (
+ FileStructure::get_filename($tree, 'tree_URL').
+ '/'.
+ $FileStructure::DEFAULT_HTML_PAGE
+ );
+
+ my ($link) = HTMLPopUp::Link(
+ "linktxt"=>"Tinderbox page",
+ "href"=>$url,
+ );
+ $out = <<EOF;
+Content-type: text/html
+
+<HTML>
+</HEAD>
+<TITLE>tinderbox</TITLE>
+<META HTTP-EQUIV="Refresh" CONTENT="0; URL=$url">
+</HEAD>
+<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">
+Regenerating HTML now.<br>
+Please refresh the page when the redirect is complete.<br>
+Sending you back to the regenerated $link.<br>
+</FONT>
+</TD></TR></TABLE>
+</CENTER>
+</BODY>
+</HTML>
+
+EOF
+
+;
+
+ } elsif ( $ENV{"REQUEST_METHOD"} ) {
+ # called via HTTPPost
+ # Tell the webserver that everythings fine.
+
+ $out = <<EOF;
+Content-type: text/html
+
+<HTML></HTML>
+EOF
+;
+ } else {
+ # called from a log processing program.
+
+ $out = '';
+ }
+
+ print $out;
+
+ HTMLPopUp::regenerate_HTML_pages();
+
+ exit 0;
+}
diff --git a/cgi-bin/tinder.cgi b/cgi-bin/tinder.cgi
new file mode 100755
index 0000000..6876cbb
--- /dev/null
+++ b/cgi-bin/tinder.cgi
@@ -0,0 +1,555 @@
+#!/usr/bin/perl -T --
+# -*- Mode: perl; indent-tabs-mode: nil -*-
+#
+
+# $Revision: 1.38 $
+# $Date: 2004/08/07 13:12:10 $
+# $Author: kestes%walrus.com $
+# $Source: /cvsroot/mozilla/webtools/tinderbox2/src/bin/tinder.cgi,v $
+# $Name: $
+
+# tinder.cgi - the main tinderbox program. This program make all the
+# HTML pages.
+
+# The contents of this file are subject to the Mozilla Public
+# License Version 1.1 (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.
+#
+
+# complete rewrite by Ken Estes for contact info see the
+# mozilla/webtools/tinderbox2/Contact file.
+# Contributor(s):
+
+
+
+# Standard perl libraries
+use File::Basename;
+use Sys::Hostname;
+use Time::Local;
+
+
+# Tinderbox libraries
+
+use lib '/srv/tinderbox/local_conf',
+ '/srv/tinderbox/default_conf',
+ '/srv/tinderbox/lib';
+
+use TinderConfig;
+use Utils;
+use TreeData;
+use BTData;
+use FileStructure;
+use HTMLPopUp;
+use VCDisplay;
+use Summaries;
+use TinderDB;
... etc. - the rest is truncated
More information about the ooo-build-commit
mailing list