#!/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); }