clearadm/lib/User.pm

   1 =pod
   2
   3 =head2 NAME $RCSfile: User.pm,v $
   4
   5 Return information about a user
   6
   7 =head2 VERSION
   8
   9 =over
  10
  11 =item Author
  12
  13 Andrew DeFaria <Andrew@ClearSCM.com>
  14
  15 =item Revision
  16
  17 $Revision: 1.4 $
  18
  19 =item Created
  20
  21 Tue Jan  3 11:36:10 PST 2006
  22
  23 =item Modified
  24
  25 $Date: 2011/01/09 01:03:10 $
  26
  27 =back
  28
  29 =head2 SYNOPSIS
  30
  31 This module implements a User object which returns information about a user.
  32
  33  my $user = new User ('adefaria');
  34
  35  print "Fullname: $user->{fullname}\n";
  36  print "EMail: $user->{email}\n";
  37
  38 =head2 DESCRIPTION
  39
  40 This module instanciates a user object for the given user identifier and
  41 then collects information about the user such as fullname, email, etc. It does
  42 so by contacting Active Directory in a Windows domain or other directory servers
  43 depending on the site. As such exactly what data members are available may
  44 change or be different from site to site.
  45
  46 =cut
  47
  48 package User;
  49
  50 use strict;
  51 use warnings;
  52
  53 use Carp;
  54 use Net::LDAP;
  55
  56 use GetConfig;
  57
  58 # Seed options from config file
  59 our %CLEAROPTS= GetConfig ("$FindBin::Bin/etc/clearuser.conf");
  60
  61 our $VERSION  = '$Revision: 1.4 $';
  62    ($VERSION) = ($VERSION =~ /\$Revision: (.*) /);
  63
  64 # Override options if in the environment
  65 $CLEAROPTS{CLEARUSER_LDAPHOST} = $ENV{CLEARUSER_LDAPHOST}
  66   if $ENV{CLEARUSER_LDAPHOST};
  67 $CLEAROPTS{CLEARUSER_BIND}     = $ENV{CLEARUSER_BIND}
  68   if $ENV{CLEARUSER_BIND};
  69 $CLEAROPTS{CLEARUSER_USERNAME} = $ENV{CLEARUSER_USERNAME}
  70   if $ENV{CLEARUSER_USERNAME};
  71 $CLEAROPTS{CLEARUSER_PASSWORD} = $ENV{CLEARUSER_PASSWORD}
  72   if $ENV{CLEARUSER_PASSWORD};
  73 $CLEAROPTS{CLEARUSER_BASEDN}   = $ENV{CLEARUSER_BASEDN}
  74   if $ENV{CLEARUSER_BASEDN};
  75
  76 my ($ldap, $ad);
  77
  78 sub unix2sso ($) {
  79   my ($unix) = @_;
  80
  81   my $firstchar  = substr $unix, 0, 1;
  82   my $secondchar = substr $unix, 1, 1;
  83
  84   # Crazy mod 36 math!
  85   my $num = (ord ($firstchar) - 97) * 36 + (ord ($secondchar) - 97) + 100;
  86
  87   my $return = $num . substr $unix, 2, 6;
  88
  89   return $return;
  90 } # unix2sso
  91
  92 sub GetOwnerInfo ($) {
  93   my ($userid) = @_;
  94
  95   my @parts = split /(\/|\\)/, $userid;
  96
  97   if (@parts == 3) {
  98     $userid = $parts[2];
  99   } # if
 100
 101   my $sso = unix2sso ($userid);
 102
 103   unless ($ldap) {
 104     $ldap = Net::LDAP->new ($CLEAROPTS{CLEARUSER_LDAPHOST})
 105       or croak 'Unable to create LDAP object';
 106
 107     $ad = $ldap->bind (
 108       "$CLEAROPTS{CLEARUSER_USERNAME}\@$CLEAROPTS{CLEARUSER_BIND}",
 109       password => $CLEAROPTS{CLEARUSER_PASSWORD});
 110   } # unless
 111
 112   $ad = $ldap->search (
 113     base   => $CLEAROPTS{CLEARUSER_BASEDN},
 114     filter => "(&(objectclass=user)(sAMAccountName=$sso))",
 115   );
 116
 117   $ad->code
 118     && croak $ad->error;
 119
 120   my @entries = $ad->entries;
 121
 122   my %ownerInfo;
 123
 124   if (@entries == 1) {
 125     for (my $i = 0; $i < $ad->count; $i++) {
 126       my $entry = $ad->entry ($i);
 127
 128       foreach my $attribute ($entry->attributes) {
 129         $ownerInfo{$attribute} = $entry->get_value ($attribute)
 130       } # foreach
 131     } # for
 132
 133     return %ownerInfo;
 134   } else {
 135     return;
 136   } # if
 137 } # GetOwnerInfo
 138
 139 =pod
 140
 141 =item new ($id)
 142
 143 Returns a new user object based on $id
 144
 145 Parameters:
 146
 147 =begin html
 148
 149 <blockquote>
 150
 151 =end html
 152
 153 =over
 154
 155 =item $id
 156
 157 User identifier
 158
 159 =back
 160
 161 =begin html
 162
 163 </blockquote>
 164
 165 =end html
 166
 167 Returns:
 168
 169 =begin html
 170
 171 <blockquote>
 172
 173 =end html
 174
 175 =over
 176
 177 =item User object
 178
 179 =back
 180
 181 =begin html
 182
 183 </blockquote>
 184
 185 =end html
 186
 187 =cut
 188
 189 sub new ($) {
 190   my ($class, $userid) = @_;
 191
 192   croak "Must specify userid to User constructor"
 193     if @_ == 1;
 194
 195   my %members;
 196
 197   $members{id} = $userid;
 198
 199   my %ownerInfo = GetOwnerInfo ($userid);
 200
 201   $members{$_} = $ownerInfo{$_}
 202     foreach (keys %ownerInfo);
 203
 204   return bless \%members, $class;
 205 } # new
 206
 207 1;
 208
 209 =pod
 210
 211 =head1 CONFIGURATION AND ENVIRONMENT
 212
 213 DEBUG: If set then $debug is set to this level.
 214
 215 VERBOSE: If set then $verbose is set to this level.
 216
 217 TRACE: If set then $trace is set to this level.
 218
 219 =head1 DEPENDENCIES
 220
 221 =head2 Perl Modules
 222
 223 L<Carp>
 224
 225 L<Net::LDAP|Net::LDAP>
 226
 227 =head2 ClearSCM Perl Modules
 228
 229 =begin man
 230
 231  GetConfig
 232
 233 =end man
 234
 235 =begin html
 236
 237 <blockquote>
 238 <a href="http://clearscm.com/php/scm_man.php?file=lib/GetConfig.pm">GetConfig</a><br>
 239 </blockquote>
 240
 241 =end html
 242
 243 =head1 BUGS AND LIMITATIONS
 244
 245 There are no known bugs in this module
 246
 247 Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
 248
 249 =head1 LICENSE AND COPYRIGHT
 250
 251 Copyright (c) 2010, ClearSCM, Inc. All rights reserved.
 252
 253 =cut