11 use Authen::Simple::LDAP;
17 our $VERSION = '$Revision: 2.23 $';
18 ($VERSION) = ($VERSION =~ /\$Revision: (.*) /);
20 my $p4config = $ENV{P4_CONF} || dirname (__FILE__) . '/../etc/p4.conf';
21 my $ldapconfig = $ENV{LDAP_CONF} || dirname (__FILE__) . '/../etc/LDAP.conf';
23 my %P4OPTS = GetConfig $p4config if -r $p4config;
24 my %LDAPOPTS = GetConfig $ldapconfig if -r $ldapconfig;
26 my $serviceUser = 'shared';
27 my ($domain, $password);
28 my $defaultPort = 'perforce:1666';
29 my $p4tickets = $^O =~ /win/i ? 'C:/Program Files/Devops/Perforce/p4tickets'
30 : '/opt/audience/perforce/p4tickets';
34 # If USERDOMAIN is set and equal to audience then set $domain to ''. This will
35 # use the Audience domain settings in LDAP.conf.
36 if ($ENV{USERDOMAIN}) {
37 if (lc $ENV{USERDOMAIN} eq 'audience') {
40 $domain = $ENV{USERDOMAIN}
45 my ($class, %parms) = @_;
47 my $self = bless {}, $class;
49 $self->{P4USER} = $parms{username} || $P4OPTS{P4USER} || $ENV{P4USER} || $serviceUser;
50 $self->{P4PASSWD} = $parms{password} || $P4OPTS{P4PASSWD} || $ENV{P4PASSWD} || undef;
51 $self->{P4CLIENT} = $parms{p4client} || $P4OPTS{P4CLIENT} || $ENV{P4CLIENT} || undef;
52 $self->{P4PORT} = $parms{p4port} || $ENV{P4PORT} || $defaultPort;
54 $self->{P4} = $self->connect (%parms);
60 my ($self, $cmd, $exit) = @_;
62 my $msg = "Unable to run \"p4 $cmd\"";
63 my $errors = $self->{P4}->ErrorCount;
65 error "$msg\n" . $self->{P4}->Errors, $exit if $errors;
73 $self->{P4} = P4->new;
75 $self->{P4}->SetUser ($self->{P4USER});
76 $self->{P4}->SetClient ($self->{P4CLIENT}) if $self->{P4CLIENT};
77 $self->{P4}->SetPort ($self->{P4PORT});
78 $self->{P4}->SetPassword ($self->{P4PASSWD}) unless $self->{P4USER} eq $serviceUser;
80 verbose_nolf "Connecting to Perforce server $self->{P4PORT}...";
81 $self->{P4}->Connect or croak "Unable to connect to Perforce Server\n";
84 verbose_nolf "Logging in as $self->{P4USER}\@$self->{P4PORT}...";
86 unless ($self->{P4USER} eq $serviceUser) {
87 $self->{P4}->RunLogin;
89 $self->errors ('login', $self->{P4}->ErrorCount);
91 $ENV{P4TICKETS} = $p4tickets if $self->{P4USER} eq $serviceUser;
99 sub _authenticateUser ($$$$) {
100 my ($self, $domain, $username, $p4client) = @_;
102 $domain .= '_' unless $domain eq '';
105 my $ad = Authen::Simple::LDAP->new (
106 host => $LDAPOPTS{"${domain}AD_HOST"},
107 basedn => $LDAPOPTS{"${domain}AD_BASEDN"},
108 port => $LDAPOPTS{"${domain}AD_PORT"},
109 filter => $LDAPOPTS{"${domain}AD_FILTER"},
112 # Read the password from <stdin> and truncate the newline - unless we already
113 # read in the password
116 $password = GetPassword;
124 # Special handling of "shared" user
125 if ($username eq 'shared') {
126 my $sharedAcl = "$FindBin::Bin/sharedAcl.txt";
128 croak "Unable to find file $sharedAcl" unless -f $sharedAcl;
130 open my $sharedAcls, '<', $sharedAcl
131 or croak "Unable to open $sharedAcl - $!";
133 chomp (my @acls = <$sharedAcls>);
141 exit if $p4client =~ /$_/;
143 exit if $_ eq $p4client;
148 # Connect to Perforce
149 $self->connect unless $self->{P4};
151 # Must be a valid Perforce user
152 return unless $self->getUser ($username);
154 # And supply a valid username/password
155 return $ad->authenticate ($username, $password);
156 } # _authenticateUser
158 sub authenticateUser ($;$) {
159 my ($self, $username, $p4client) = @_;
162 # If $domain is set to '' then we'll check Audience's LDAP.
163 # If $domain is not set (undef) then we'll try Knowles first, then Audience
164 # otherwise we will take $DOMAIN and look for those settings...
166 unless ($self->_authenticateUser ('KNOWLES', $username, $p4client)) {
167 unless ($self->_authenticateUser ('', $username, $p4client)) {
173 unless ($self->_authenticateUser ('', $username, $p4client)) {
177 unless ($self->_authenticateUser ($domain, $username, $p4client)) {
184 return $self->_authenticateUser ('KNOWLES', $username, $p4client);
190 my ($self, $args, %opts) = @_;
195 if (/from/i and $opts{to}) {
196 $args .= " $opts{$_},$opts{to}";
200 $args .= " $opts{$_}";
204 my $changes = $self->{P4}->Run ($cmd, $args);
206 return $self->errors ("$cmd $args") || $changes;
210 my ($self, $job) = @_;
212 my $jobs = $self->{P4}->IterateJobs ("-e $job");
214 return $self->errors ("jobs -e $job") || $job;
218 my ($self, $changelist) = @_;
220 my $change = $self->{P4}->FetchChange ($changelist);
222 return $self->errors ("change $changelist") || $change;
226 my ($self, $changelist) = @_;
228 my $files = $self->{P4}->Run ('files', "\@=$changelist");
230 return $self->errors ("files \@=$changelist") || $files;
234 my ($self, $fileSpec, %opts) = @_;
236 return $self->{P4}->RunFilelog ($fileSpec, %opts);
239 sub getRevision ($;$) {
240 my ($self, $filename, $revision) = @_;
243 if ($filename =~ /#/) {
244 ($filename, $revision) = split $filename, '#';
246 error "No revision specified in $filename";
252 my @contents = $self->{P4}->RunPrint ("$filename#$revision");
254 if ($self->{P4}->ErrorCount) {
255 $self->errors ("Print $filename#$revision");
264 my ($self, $user) = @_;
266 $user //= $ENV{P4USER} || $ENV{USER};
269 my @args = ('-o', $user);
271 my $userRecs = $self->{P4}->Run ($cmd, @args);
273 # Perforce returns an array of qualifying users. We only care about the first
274 # one. However if the username is invalid, Perforce still returns something
275 # that looks like a user. We look to see if there is a Type field here which
276 # indicates that it's a valid user
277 if ($userRecs->[0]{Type}) {
278 return %{$userRecs->[0]};
284 sub renameSwarmUser ($$) {
285 my ($self, $oldusername, $newusername) = @_;
287 # We are turning this off because Perforce support says that just modifying
288 # the keys we do not update the indexing done in the Perforce Server/Database.
289 # So instead we have a PHP script (renameUser.php) which goes through the
290 # official, but still unsupported, "Swarm Record API" to change the usernames
291 # and call the object's method "save" which should perform the necessary
292 # reindexing... Stay tuned! :-)
294 # BTW One needs to run renameUser.php by hand as we do not do that here.
297 $keys = $self->getKeys ('swarm-*') unless $keys;
302 if ($key{value} =~ /$oldusername/) {
303 $key{value} =~ s/\"$oldusername\"/\"$newusername\"/g;
304 $key{value} =~ s/\@$oldusername /\@$newusername /g;
305 $key{value} =~ s/\@$oldusername\./\@$newusername\./g;
306 $key{value} =~ s/\@$oldusername,/\@$newusername,/g;
307 $key{value} =~ s/ $oldusername / $newusername /g;
308 $key{value} =~ s/ $oldusername,/ $newusername,/g;
309 $key{value} =~ s/ $oldusername\./ $newusername\./g;
310 $key{value} =~ s/-$oldusername\"/-$newusername\"/g;
314 display "Correcting key $key{key}";
316 my @result = $self->{P4}->Run ($cmd, $key{key}, $key{value});
318 $self->errors ($cmd, $result[0]->{key} || 1);
325 sub renameUser ($$) {
326 my ($self, $old, $new) = @_;
328 my $cmd = 'renameuser';
329 my @args = ("--from=$old", "--to=$new");
331 $self->{P4}->Run ($cmd, @args);
333 my $status = $self->errors (join ' ', $cmd, @args);
335 return $status if $status;
337 # return $self->renameSwarmUser ($old, $new);
341 my ($self, %user) = @_;
343 # Trying to do this with P4Perl is difficult. First off the structure needs
344 # to be AOH and secondly you need to call SetUser to be the other user. That
345 # said you need to also specify -f to force the update (which means you must
346 # a admin (or superuser?) and I found no way to specify -f so I've reverted
347 # back to using p4 from the command line. I also don't like having to use
349 my $tmpfile = File::Temp->new;
350 my $tmpfilename = $tmpfile->filename;
352 print $tmpfile "User: $user{User}\n";
353 print $tmpfile "Email: $user{Email}\n";
354 print $tmpfile "Update: $user{Update}\n";
355 print $tmpfile "FullName: $user{FullName}\n";
359 my @lines = `p4 -p $self->{P4PORT} user -f -i < $tmpfilename`;
362 return wantarray ? @lines : join '', @lines;
366 my ($self, $filter) = @_;
376 my $keys = $self->{P4}->Run ($cmd, @args);
378 $self->errors ($cmd . join (' ', @args), 1);
384 my ($self, $name, $value) = @_;
387 my @args = ($name, $value);
389 $self->{P4}->Run ($cmd, @args);
391 return $self->errors (join ' ', $cmd, @args);