#!/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 print $q->start_html(-title=>'Perforce Group Manipulation', -style=>{-code=>$style}); print "\n"; &print_header(); &do_work(); print "
\n"; open (DAT, "<$datfile") || die "Cannot open $datfile, $!"; my (@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 "\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 "\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 "\n"; #print "
$message
\n"; } } elsif ($direction eq "view log") { open (LOG, "<$logfile"); my (@log) = ; close (LOG); print "\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 "\n"; plog ("[" . scalar(localtime) . "] $webuser added " . join (", ", @users) . " to $group"); } else { print "\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 "\n"; plog ("[" . scalar(localtime) . "] $webuser removed " . join (", ", @groupuser) . " from $group"); } else { print "\n"; } } print "
password changed for $webuser
failed to change password for $webuser
\n"; if ($#log >= 0) { print "Perforce Group Manipulation Log
\n"; print $q->scrolling_list( -name=>'log', -values=>\@log, -size=>20, ); } else { print "There is nothing in the log, yet.\n"; } print "
" . join (", ", @users), " $word been added to $group
Nothing was selected.
" . join (", ", @groupuser), " $word been removed from $group
Nothing was selected.
\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 "\n"; print "\n"; print "\n"; print "
\n"; print ""; print "
\n"; print $q->popup_menu( -name=>'group', -default=>$group, -values=>$groups); print "\n"; print $q->submit(-name=>'direction', -value=>'group'); print "
\n"; print ""; print "\n"; print "\n"; print "
Perforce UsersUsers in $group
\n"; print $q->scrolling_list( -name=>'user', -values=>$sanitized_users, -size=>10, -multiple=>'true'); print "\n"; print $q->submit(-name=>'direction', -value=>'->'); print $q->submit(-name=>'direction', -value=>'<-'); print "\n"; print $q->scrolling_list( -name=>'groupuser', -values=>\@groupusers, -size=>10, -multiple=>'true'); print "
\n"; print $q->submit(-name=>'direction', -value=>'refresh'); print "
\n"; print "
\n"; if ($#subgroupusers >= 0) { print ""; } if ($removal) { print "\n"; } print "
"; print "This group has subgroup(s) containing the following users: "; print join (", ", @subgroupusers); print ". Your actions won't affect their privileges.
Users in this group will be removed every 30 mins upon submission to Perforce.
\n"; print "

\n"; &print_footer(); print $q->hidden('webuser',$webuser); print $q->endform; } sub print_header() { print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "

Perforce Group Manipulation

\n"; print "
\n"; print "
\n"; } sub print_footer() { print "

\n"; print "\n"; print "\n"; print "
\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "\n"; print "
old passwdnew passwd\n"; print $q->submit(-name=>'direction', -value=>'view log'); print "
"; print $q->password_field( -name=>'oldpasswd', -size=>10, -maxlength=>25); print ""; print $q->password_field( -name=>'newpasswd', -size=>10, -maxlength=>25); print "\n"; print $q->submit(-name=>'direction', -value=>'change passwd'); print "
\n"; print "
\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); }