#!/usr/bin/perl
# a perl cgi script used to manipulate perforce groups
# veshi@veshi.com
use vars qw($p4 $group $removal $logfile, $datfile);
use CGI;
use Apache::Htpasswd;
# the perforce env variables here are defined in httpd.conf
my ($p4) = "/usr/local/bin/p4 -u $ENV{P4USER} -P $ENV{P4PASSWD} -p $ENV{P4PORT} ";
my ($q) = new CGI;
my ($htp) = new Apache::Htpasswd("/var/www/.htpasswd");
$logfile = "/var/www/p4gm/logs/groupmanip.log";
$datfile = "/var/www/p4gm/p4gm.dat";
my ($group) = $q->param('group');
my ($webuser) = $q->remote_user();
$webuser ||= $q->param('webuser');
print $q->header;
my ($style) = <<NOMORESTYLE;
<!--
BODY {
background: white;
}
.shadyheading {
background: #dddddd;
font-weight: bold;
text-align: center;
}
.response {
background: #006699;
font-weight: bold;
color: white;
}
}
-->
NOMORESTYLE
print $q->start_html(-title=>'Perforce Group Manipulation',
-style=>{-code=>$style});
print "<table width=100%>\n";
&print_header();
&do_work();
print "</table>\n";
open (DAT, "<$datfile") || die "Cannot open $datfile, $!";
my (@dat) = <DAT>;
close (DAT);
# restrict groups by webuser
foreach (@dat) {
chomp;
next if (/^#/);
my ($datuser, @datgroups) = split (/:/);
if ($#datgroups == 0 && $datgroups[0] eq "showmeall") {
@datgroups = `$p4 groups`;
}
if ($webuser eq $datuser) {
$group ||= $datgroups[0]; # default
@groups = @datgroups; # choices
last;
}
}
chomp (@groups);
# cronjob removes users from these groups
$removal = 0;
#TODO:
#if ($group eq "r1.2" || $group eq "r1.3") {
# $removal = 1;
#}
&print_query(\@groups);
print $q->end_html;
sub do_work {
print "<table width=50%>\n";
my (@users) = $q->param('user');
my (@groupuser) = $q->param('groupuser');
my ($direction) = $q->param('direction');
if ($direction eq "group") {
} elsif ($direction eq "change passwd") {
my ($oldpasswd) = $q->param('oldpasswd');
my ($newpasswd) = $q->param('newpasswd');
my ($result) = $htp->htpasswd("$webuser", "$newpasswd", "$oldpasswd");
if ($result) {
print "<tr class=response><td align=center>password changed for $webuser</td></tr>\n";
# since the action was successfull, get rid of the values of these
# parameters
$q->delete('oldpasswd');
$q->delete('newpasswd');
} else {
my ($message) = $htp->error;
print "<tr class=response><td align=center><b>failed</b> to change password for $webuser</td></tr>\n";
#print "<br>$message<br>\n";
}
} elsif ($direction eq "view log") {
open (LOG, "<$logfile");
my (@log) = <LOG>;
close (LOG);
print "<tr class=response><td align=center>\n";
if ($#log >= 0) {
print "Perforce Group Manipulation Log</td></tr><tr><td>\n";
print $q->scrolling_list(
-name=>'log',
-values=>\@log,
-size=>20,
);
} else {
print "There is nothing in the log, yet.\n";
}
print "</td></tr>\n";
} elsif ($direction eq "->") {
if ($#users >= 0) {
my ($word);
if ($#users > 0) {
$word = "have";
} else {
$word = "has";
}
my (@template) = `$p4 group -o $group`;
open (GROUP, "| $p4 group -i > /dev/null");
print GROUP join ("\n", @template);
foreach $user (@users) {
print GROUP "\t$user\n";
}
close GROUP;
print "<tr class=response><td align=center>" . join (", ", @users), " $word been added to $group</td></tr>\n";
plog ("[" . scalar(localtime) . "] $webuser added " . join (", ", @users) . " to $group");
} else {
print "<tr class=response><td align=center>Nothing was selected.</td></td>\n";
}
} elsif ($direction eq "<-") {
if ($#groupuser >= 0) {
my ($word);
if ($#groupuser > 0) {
$word = "have";
} else {
$word = "has";
}
my (@p4groupusers) = `$p4 group -o $group`;
my (@groupusers);
my ($index);
for my $i (0..$#p4groupusers) {
if ($p4groupusers[$i] =~ /^Users:$/) {
$index = $i;
last;
}
}
$index ++;
for my $i ($index..$#p4groupusers) {
if ($p4groupusers[$i] =~ /\t(.*)/) {
push (@groupusers, $1);
}
}
my ($sanitizedgroupusers) = sanitize(\@groupusers,\@groupuser);
# each user has to have a tab in front of it
foreach (@$sanitizedgroupusers) {
$_ =~ s/^/\t/;
}
splice(@p4groupusers,$index);
push(@p4groupusers, @$sanitizedgroupusers);
open (GROUP, "| $p4 group -i > /dev/null");
print GROUP join ("\n", @p4groupusers);
close GROUP;
print "<tr class=response><td align=center>" . join (", ", @groupuser), " $word been removed from $group</td></tr>\n";
plog ("[" . scalar(localtime) . "] $webuser removed " . join (", ", @groupuser) . " from $group");
} else {
print "<tr class=response><td align=center>Nothing was selected.</td></td>\n";
}
}
print "</table>\n";
}
sub print_query {
my ($groups) = @_;
my (@users);
my (@p4users) = `$p4 users`;
foreach (@p4users) {
if (/(.*) \<.*\> \(.*\) .* \d+\/\d+\/\d+/) {
push (@users, $1);
}
}
my (@p4groupusers) = `$p4 group -o $group`;
my (@groupusers);
my ($index, $subindex);
for my $i (0..$#p4groupusers) {
if ($p4groupusers[$i] =~ /^Subgroups:$/) {
$subindex = $i;
} elsif ($p4groupusers[$i] =~ /^Users:$/) {
$index = $i;
last;
}
}
# list of users in this group
for my $i ($index..$#p4groupusers) {
if ($p4groupusers[$i] =~ /\t(.*)/) {
push (@groupusers, $1);
}
}
# list of subgroups in this group
for my $i ($subindex..($index - 1)) {
my ($subuserindex);
if ($p4groupusers[$i] =~ /\t(.*)/) {
my (@p4subgroupusers) = `$p4 group -o $1`;
# list of users in this subgroup
for my $j (0..$#p4subgroupusers) {
if ($p4groupusers[$j] =~ /^Users:$/) {
$subuserindex = $j;
last;
}
}
for my $j ($subuserindex..$#p4subgroupusers) {
if ($p4subgroupusers[$j] =~ /\t(.*)/) {
push (@subgroupusers, $1);
}
}
}
}
my ($sanitized_users) = sanitize(\@users, \@groupusers);
print $q->start_form;
print "<table width=100%>\n";
print "<tr><td align=center>\n";
print "<table>";
print "<tr><td>\n";
print $q->popup_menu(
-name=>'group',
-default=>$group,
-values=>$groups);
print "</td><td>\n";
print $q->submit(-name=>'direction', -value=>'group');
print "</td></tr></table>\n";
print "<table>";
print "<tr><td>Perforce Users</td><td></td><td>Users in $group</td></tr>\n";
print "<tr><td>\n";
print $q->scrolling_list(
-name=>'user',
-values=>$sanitized_users,
-size=>10,
-multiple=>'true');
print "</td><td>\n";
print $q->submit(-name=>'direction', -value=>'->');
print $q->submit(-name=>'direction', -value=>'<-');
print "</td><td>\n";
print $q->scrolling_list(
-name=>'groupuser',
-values=>\@groupusers,
-size=>10,
-multiple=>'true');
print "</td></tr><tr><td align=center colspan=3>\n";
print $q->submit(-name=>'direction', -value=>'refresh');
print "</td></tr>\n";
print "</table>\n";
print "</td></tr>\n";
print "<tr><td align=center><table width=50%>\n";
if ($#subgroupusers >= 0) {
print "<tr><td align=left>";
print "This group has subgroup(s) containing the following users: ";
print join (", ", @subgroupusers);
print ". Your actions won't affect their privileges.</td></tr>";
}
if ($removal) {
print "<tr><td align=left>Users in this group will be removed every 30 mins upon submission to Perforce.</td></tr>\n";
}
print "</table></td></tr>\n";
print "</table>\n";
print "<br><br>\n";
&print_footer();
print $q->hidden('webuser',$webuser);
print $q->endform;
}
sub print_header() {
print "<tr><td align=center>\n";
print "<table width=50%>\n";
print "<tr class=shadyheading>\n";
print "<td align=center><h2>Perforce Group Manipulation</h2></td>\n";
print "</tr>\n";
print "<tr>\n";
print "<td align=center>\n";
print "</td>\n";
print "</tr>\n";
print "</table>\n";
print "<br>\n";
}
sub print_footer() {
print "<br><br>\n";
print "<table width=100%>\n";
print "<tr><td align=center>\n";
print "<table border=1>\n";
print "<tr class=shadyheading>\n";
print "<td>old passwd</td><td>new passwd</td><td align=center>\n";
print $q->submit(-name=>'direction', -value=>'view log');
print "</td>\n";
print "</tr><tr>\n";
print "<td>";
print $q->password_field(
-name=>'oldpasswd',
-size=>10,
-maxlength=>25);
print "</td>\n";
print "<td>";
print $q->password_field(
-name=>'newpasswd',
-size=>10,
-maxlength=>25);
print "</td>\n";
print "<td>\n";
print $q->submit(-name=>'direction', -value=>'change passwd');
print "</td>\n";
print "</tr>\n";
print "</table>\n";
print "</td></tr>\n";
print "</table>\n";
}
sub plog() {
my ($line) = @_;
open (LOG, ">>$logfile");
print LOG "$line\n";
close (LOG);
}
# keep the user list clean
sub sanitize() {
my ($one, $two) = @_;
for my $i (0..$#$one) {
for my $x (0..$#$two) {
if ($$one[$i] eq $$two[$x]) {
splice(@$one,$i,1);
}
}
}
return ($one);
}