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