#!/usr/bin/perl -- # -*- 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 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. # # Contributor(s): use strict; use Tie::IxHash; require 'tbglobals.pl'; umask 002; my $perm = "0660"; # Permission of created files my $dir_perm = "0770"; # Permission of created dirs # Process the form arguments my %form = &split_cgi_args(); my %cookie_jar = &split_cookie_args(); $|=1; &tb_check_password(\%form, \%cookie_jar); print "Content-type: text/html\n\n\n"; my $command = $form{'command'}; my $tree= $form{'tree'}; if ($command eq 'create_tree') { ($tree = $form{'treename'}) =~ s/^.*?([\w-\.]+).*$/\1/; } else { $tree = &require_only_one_tree($tree); } if( $command eq 'create_tree' ){ &create_tree; } elsif( $command eq 'trim_logs' ){ &trim_logs; } elsif( $command eq 'set_status_message' ){ &set_status_message; } elsif( $command eq 'set_rules_message' ){ &set_rules_message; } elsif( $command eq 'set_sheriff' ){ &set_sheriff; } elsif ($command eq 'admin_builds') { &admin_builds; } else { print "Unknown command: \"$command\"."; } sub trim_logs { my $days = $form{'days'}; my $tree = $form{'tree'}; print "

Trimming Log files for $tree...

\n

"; my $min_date = time - (60*60*24 * $days); # # Nuke the old log files # my $i = 0; my $tblocks; opendir( D, &shell_escape($tree) ); while( my $fn = readdir( D ) ){ if( $fn =~ /\.(?:gz|brief\.html)$/ || $fn =~ m/^warn.*?\.html$/){ my ($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 ); my $k = $tblocks*512/1024; print "
$i Logfiles ( $k K bytes ) removed
\n"; # # Trim build.dat # my $builds_removed = 0; open(BD, "<", "$tree/build.dat"); open(NBD, ">", "$tree/build.dat.new"); while( ){ my ($endtime,$buildtime,$buildname) = split( /\|/ ); if( $buildtime >= $min_date ){ print NBD $_; } else { $builds_removed++; } } close( BD ); close( NBD ); unlink( "$tree/build.dat.old" ); rename( "$tree/build.dat", "$tree/build.dat.old" ); rename( "$tree/build.dat.new", "$tree/build.dat" ); # # Trim scrape.dat & warnings.dat # for my $file ("scrape.dat", "warnings.dat") { open(BD, "<", "$tree/$file"); open(NBD, ">", "$tree/$file.new"); while () { my ($logfile, $junk) = split (/\|/); my ($buildtime, $processtime, $pid) = split (/\./, $logfile); if ($buildtime >= $min_date) { print NBD $_; } } close(BD); close(NBD); unlink("$tree/$file.old"); rename("$tree/$file", "$tree/$file.old"); rename("$tree/$file.new", "$tree/$file"); } print "

$builds_removed builds removed from build.dat

\n"; print "

Back to tree

\n"; } sub create_tree { tie my %treedata => 'Tie::IxHash'; # make a copy of default_treedata to preserve order %treedata = %::default_treedata; $treedata{who_days} = $form{'who_days'}; $treedata{cvs_root} = $form{'repository'}; $treedata{cvs_module} = $form{'modulename'}; $treedata{cvs_branch}= $form{'branchname'}; $treedata{bonsai_tree} = $form{'bonsaitreename'}; $treedata{viewvc_url} = $form{'viewvc_url'}; $treedata{viewvc_repository} = $form{'viewvc_repository'}; $treedata{viewvc_dbdriver} = $form{'viewvc_dbdriver'}; $treedata{viewvc_dbhost} = $form{'viewvc_dbhost'}; $treedata{viewvc_dbport} = $form{'viewvc_dbport'}; $treedata{viewvc_dbname} = $form{'viewvc_dbname'}; $treedata{viewvc_dbuser} = $form{'viewvc_dbuser'}; $treedata{viewvc_dbpasswd} = $form{'viewvc_dbpasswd'}; $treedata{use_bonsai} = $treedata{use_viewvc} = 0; my $treename = $tree; for my $var ( 'cvs_module', 'cvs_branch', 'bonsai_tree') { $treedata{use_bonsai}++ if (defined($treedata{$var}) && "$treedata{$var}" ne ""); } for my $var ('viewvc_url','viewvc_repository', '{viewvc_dbdriver', 'viewvc_dbhost', 'viewvc_dbport', 'viewvc_dbname', 'viewvc_user', 'viewvc_passwd') { $treedata{use_viewvc}++ if (defined($treedata{$var}) && "$treedata{$var}" ne ""); } if ($treedata{use_bonsai} && $treedata{use_viewvc}) { my $errmsg = "Cannot configure tinderbox to use bonsai & viewvc at the same time."; print "

$errmsg

\n"; die "$errmsg"; } if( -r $treename ){ chmod(oct($dir_perm), $treename); } else { mkdir( $treename, oct($dir_perm)) || die "

Cannot mkdir $treename

"; } &write_treedata("$treename/treedata.pl", \%treedata); open( F, ">", "$treename/build.dat" ); close( F ); open( F, ">", "$treename/who.dat" ); close( F ); open( F, ">", "$treename/notes.txt" ); close( F ); open( F, ">", "$treename/index.html"); print F "\n"; print F "\n"; print F "\n"; print F "\n"; close( F ); chmod oct($perm), "$treename/build.dat", "$treename/who.dat", "$treename/notes.txt", "$treename/treedata.pl", "$treename/index.html"; print "

Tree created or modified

\n"; } sub admin_builds { my ($i,%active_buildnames, %scrape_buildnames, %warning_buildnames); # Read build.dat open(BD, "<", "$tree/build.dat"); while(){ my ($endtime,$buildtime,$bname) = split( /\|/ ); $active_buildnames{$bname} = 0; $scrape_buildnames{$bname} = 0; $warning_buildnames{$bname} = 0; } close(BD); for $i (keys %form) { if ($i =~ m/^active_/ ) { $i =~ s/^active_//; $active_buildnames{$i} = 1; } elsif ($i =~ m/^scrape_/ ) { $i =~ s/^scrape_//; $scrape_buildnames{$i} = 1; } elsif ($i =~ m/^warning_/ ) { $i =~ s/^warning_//; $warning_buildnames{$i} = 1; } } open(IGNORE, ">", "$tree/ignorebuilds.pl"); print IGNORE '$ignore_builds = {' . "\n"; for $i (sort keys %active_buildnames){ if ($active_buildnames{$i} == 0){ print IGNORE "\t\t'$i' => 1,\n"; } } print IGNORE "\t};\n"; close IGNORE; open(SCRAPE, ">", "$tree/scrapebuilds.pl"); print SCRAPE '$scrape_builds = {' . "\n"; for $i (sort keys %scrape_buildnames){ if ($scrape_buildnames{$i} == 1){ print SCRAPE "\t\t'$i' => 1,\n"; } } print SCRAPE "\t};\n"; close SCRAPE; open(WARNING, ">", "$tree/warningbuilds.pl"); print WARNING '$warning_builds = {' . "\n"; for $i (sort keys %warning_buildnames){ if ($warning_buildnames{$i} == 1){ print WARNING "\t\t'$i' => 1,\n"; } } print WARNING "\t};\n"; close WARNING; chmod( oct($perm), "$tree/ignorebuilds.pl", "$tree/scrapebuilds.pl", "$tree/warningbuilds.pl"); print "

Build state Changed

\n"; } sub set_sheriff { my $m = $form{'sheriff'}; $m =~ s/\'/\\\'/g; open(SHERIFF, ">", "$tree/sheriff.pl"); print SHERIFF "\$current_sheriff = '$m';\n1;"; close(SHERIFF); chmod( oct($perm), "$tree/sheriff.pl"); print "

Sheriff Changed.

\n"; } sub set_status_message { my $m = $form{'status'}; $m =~ s/\'/\\\'/g; open(TREESTATUS, ">", "$tree/status.pl"); print TREESTATUS "\$status_message = \'$m\'\;\n1;"; close(TREESTATUS); chmod( oct($perm), "$tree/status.pl"); print "

Status message changed.

\n"; } sub set_rules_message { my $m = $form{'rules'}; $m =~ s/\'/\\\'/g; open(RULES, ">", "$tree/rules.pl"); print RULES "\$rules_message = \'$m\';\n1;"; close(RULES); chmod( oct($perm), "$tree/rules.pl"); print "

Rule message changed.

\n"; }