7 =head1 NAME 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
29 $Date: 2014/10/03 18:17:20 $
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 should 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}',
56 use CGI qw (:standard);
58 # Interpolate variable in str (if any) from %opts
59 sub interpolate ($%) {
60 my ($str, %opts) = @_;
62 # Since we wish to leave undefined $var references in tact the following while
63 # loop would loop indefinitely if we don't change the variable. So we work
64 # with a copy of $str changing it always, but only changing the original $str
65 # for proper interpolations.
68 while ($copyStr =~ /\$(\w+)/) {
71 if (exists $opts{$var}) {
72 $str =~ s/\$$var/$opts{$var}/;
73 $copyStr =~ s/\$$var/$opts{$var}/;
74 } elsif (exists $ENV{$var}) {
75 $str =~ s/\$$var/$ENV{$var}/;
76 $copyStr =~ s/\$$var/$ENV{$var}/;
78 $copyStr =~ s/\$$var//;
85 sub _processFile ($%) {
86 my ($configFile, %opts) = @_;
88 while (<$configFile>) {
91 next if /^\s*[\#|\!]/; # Skip comments
93 if (/\s*(.*?)\s*[:=]\s*(.*)\s*/) {
97 # Strip trailing spaces
101 $value = interpolate $value, %opts;
104 # If the key exists already then we have a case of multiple values for
105 # the same key. Since we support this we need to replace the scalar
106 # value with an array of values...
107 if (ref $opts{$key} eq "ARRAY") {
108 # It's already an array, just add to it!
109 push @{$opts{$key}}, $value;
111 # It's not an array so make it one
114 push @a, $opts{$key};
119 # It's a simple value
120 $opts{$key} = $value;
133 open my $configFile, '<', $filename
134 or die "Unable to open config file $filename";
136 %opts = _processFile $configFile;
143 sub checkLDAPError ($$) {
144 my ($msg, $result) = @_;
146 my $code = $result->code;
148 die "$msg (Error $code)\n" . $result->error if $code;
151 my ($confFile) = ($FindBin::Script =~ /(.*)\.pl$/);
152 $confFile = "$confFile.conf";
154 my %opts = GetConfig ($confFile);
167 ) || die 'Invalid parameters';
169 $opts{userid} = param 'userid' unless $opts{userid};
171 die "Usage getPicture.pl [userid=]<userid>\n" unless $opts{userid};
173 my $ldap = Net::LDAP->new (
175 host => $opts{AD_HOST},
176 port => $opts{AD_PORT},
177 basedn => $opts{AD_BASEDN},
178 binddn => $opts{AD_BINDDN},
179 bindpw => $opts{AD_BINDPW},
183 my $result = $ldap->bind (
184 dn => $opts{AD_BINDDN},
185 password => $opts{AD_BINDPW},
186 ) or die "Unable to bind\n$@";
188 checkLDAPError ('Unable to bind', $result);
190 $result = $ldap->search (
191 base => $opts{AD_BASEDN},
192 filter => "uid=$opts{userid}",
195 checkLDAPError ('Unable to search', $result);
197 my @entries = ($result->entries);
200 print header 'image/jpeg';
201 print $entries[0]->get_value ('thumbnailPhoto');