7 =head1 NAME $File: //AudEngr/Import/VSS/ReleaseEng/Dev/Perforce/getPicture.pl $
9 Retrieve thumbnailPhoto for the userid from Active Directory
17 Andrew DeFaria <Andrew@ClearSCM.com>
25 Fri Oct 3 18:16:26 PDT 2014
35 This script will take a userid and search the Active Directory for the user and
36 return an image file if the user has an image associated with his
37 thumbnailPhoto attribute.
39 This can be configured into Perforce Swarn as documented:
41 http://www.perforce.com/perforce/doc.current/manuals/swarm/admin.avatars.html
43 One would use something like
45 // this block shoudl be a peer of 'p4'
47 'http_url' => 'http://<server>/cgi-bin/getPicture.pl?userid={user}'
48 'https_url' => 'http://<server>/cgi-bin/getPicture.pl?userid={user}',
57 use CGI qw (:standard);
59 # Interpolate variable in str (if any) from %opts
60 sub interpolate ($%) {
61 my ($str, %opts) = @_;
63 # Since we wish to leave undefined $var references in tact the following while
64 # loop would loop indefinitely if we don't change the variable. So we work
65 # with a copy of $str changing it always, but only changing the original $str
66 # for proper interpolations.
69 while ($copyStr =~ /\$(\w+)/) {
72 if (exists $opts{$var}) {
73 $str =~ s/\$$var/$opts{$var}/;
74 $copyStr =~ s/\$$var/$opts{$var}/;
75 } elsif (exists $ENV{$var}) {
76 $str =~ s/\$$var/$ENV{$var}/;
77 $copyStr =~ s/\$$var/$ENV{$var}/;
79 $copyStr =~ s/\$$var//;
86 sub _processFile ($%) {
87 my ($configFile, %opts) = @_;
89 while (<$configFile>) {
92 next if /^\s*[\#|\!]/; # Skip comments
94 if (/\s*(.*?)\s*[:=]\s*(.*)\s*/) {
98 # Strip trailing spaces
102 $value = interpolate $value, %opts;
105 # If the key exists already then we have a case of multiple values for
106 # the same key. Since we support this we need to replace the scalar
107 # value with an array of values...
108 if (ref $opts{$key} eq "ARRAY") {
109 # It's already an array, just add to it!
110 push @{$opts{$key}}, $value;
112 # It's not an array so make it one
115 push @a, $opts{$key};
120 # It's a simple value
121 $opts{$key} = $value;
134 open my $configFile, '<', $filename
135 or die "Unable to open config file $filename";
137 %opts = _processFile $configFile;
144 sub checkLDAPError ($$) {
145 my ($msg, $result) = @_;
147 my $code = $result->code;
149 die "$msg (Error $code)\n" . $result->error if $code;
152 my ($confFile) = ($FindBin::Script =~ /(.*)\.pl$/);
153 $confFile = "$FindBin::Bin/$confFile.conf";
155 my %opts = GetConfig ($confFile);
170 $opts{userid} = param 'userid' unless $opts{userid};
172 pod2usage "Usage getPicture.pl [userid=]<userid>\n" unless $opts{userid};
174 my $ldap = Net::LDAP->new (
176 host => $opts{AD_HOST},
177 port => $opts{AD_PORT},
178 basedn => $opts{AD_BASEDN},
179 binddn => $opts{AD_BINDDN},
180 bindpw => $opts{AD_BINDPW},
184 my $result = $ldap->bind (
185 dn => $opts{AD_BINDDN},
186 password => $opts{AD_BINDPW},
187 ) or die "Unable to bind\n$@";
189 checkLDAPError ('Unable to bind', $result);
191 $result = $ldap->search (
192 base => $opts{AD_BASEDN},
193 filter => "sAMAccountName=$opts{userid}",
196 checkLDAPError ('Unable to search', $result);
198 my @entries = ($result->entries);
201 print header 'image/jpeg';
202 print $entries[0]->get_value ('thumbnailPhoto');