0: #!/usr/bin/perl -w
1: # Copyright (C) 2001 Steve Haslam
2: # This is free software
3: # This script may be modified and/or reproduced under the terms of the
4: # GNU Public License version 2 or later.
5: 
6: require 5.6.0;
7: use strict;
8: use Net::LDAP;
9: use Net::LDAP::Util qw(ldap_error_text);
10: use GD;
11: use Getopt::Std;
12: use Term::ReadKey;
13: use Mail::Sendmail;
14: 
15: # Most of the configuration is here
16: 
17: our $basedn = "ou=People, o=Excite, c=GB";
18: our $host = "ldap.london.excite.com";
19: our $basefilter = "(objectClass=excitePerson)";
20: our $maxfilesize = 75*1024;
21: our $maxwidth = 600;
22: our $maxheight = 800;
23: our $makeurl = sub { 'http://www.london.excite.com/directory/'.$_[0]->get_value('uid').'/' };
24: 
25: # Code
26: 
27: our %opts;
28: getopts('dD:w:', \%opts) or die "Syntax: $0 [-d] [-D binddn] [-w bindpw]\n";
29: our $deletemode = $opts{'d'};
30: our $adminemail = 'root@london.excite.com';
31: 
32: sub ldapassert {
33:   my $mesg = shift;
34:   my $action = shift;
35:   return $mesg if (!$mesg->code);
36:   my $errortext = ldap_error_text($mesg->code);
37:   chomp $errortext;
38:   die "LDAP: $errortext ($action)\n";
39: }
40: 
41: our $ldap = Net::LDAP->new($host) or die "Unable to connect to $host: $@";
42: 
43: if ($opts{'D'}) {
44:   my $binddn = $opts{'D'};
45:   my $bindpw = $opts{'w'};
46:   if (!$bindpw) {
47:     print "Password: ";
48:     ReadMode 'noecho';
49:     $bindpw = <STDIN>;
50:     ReadMode 'restore';
51:     chomp $bindpw;
52:   }
53:   ldapassert($ldap->bind(dn => $binddn, password => $bindpw), "authenticated bind");
54:   print "OK.\n";
55: }
56: else {
57:   ldapassert($ldap->bind(), "anonymous bind");
58: }
59: 
60: my $sr = ldapassert($ldap->search(base => $basedn, filter => "(&(jpegphoto=*)$basefilter)", scope => 'sub'));
61: 
62: while (my $entry = $sr->shift_entry) {
63:   my %problems;
64:   my @photos = $entry->get_value('jpegPhoto');
65:   foreach my $photoindex (1..@photos) {
66:     my $size = length($photos[$photoindex-1]);
67:     my $gdwarnings;
68:     my $im = GD::Image->newFromJpegData($photos[$photoindex-1]);
69:     if (!$im) {
70:       push(@{$problems{$photoindex}}, "Photo #$photoindex is not a valid JPEG image");
71:     }
72:     elsif ($maxfilesize && $size > $maxfilesize) {
73:       push(@{$problems{$photoindex}}, "Photo #$photoindex exceeds maximum file size of $maxfilesize bytes");
74:     }
75:     else {
76:       my($width, $height) = $im->getBounds;
77:       if ($maxwidth && $width > $maxwidth) {
78: 	push(@{$problems{$photoindex}}, "Photo #$photoindex exceeds maximum width of $maxwidth pixels");
79:       }
80:       if ($maxheight && $height > $maxheight) {
81: 	push(@{$problems{$photoindex}}, "Photo #$photoindex exceeds maximum height of $maxheight pixels");
82:       }
83:     }
84:   }
85:   if (%problems) {
86:     if ($deletemode) {
87:       my @delphotos = keys %problems;
88:       if (@delphotos == @photos) {
89: 	# We are deleting all the photos, just send a delete command
90: 	print $entry->dn, ": Deleting photos: ", join(', ', map {$_ - 1} @delphotos), " (using delete)\n";
91: 	$entry->delete('jpegPhoto');
92:       }
93:       else {
94: 	# Use a replace command
95: 	print $entry->dn, ": Deleting photos: ", join(', ', map {$_ - 1} @delphotos), " (using replace)\n";
96: 	my @newphotos;
97: 	foreach my $oldphotoindex (1..@photos) {
98: 	  next if (grep { $_ == $oldphotoindex } @delphotos);
99: 	  push(@newphotos, $photos[$oldphotoindex]);
100: 	}
101: 	$entry->replace(jpegPhoto => \@newphotos);
102:       }
103:       ldapassert($entry->update($ldap), "updating ".$entry->dn);
104:     }
105:     else {
106:       my $mailto = $entry->get_value('cn').' <'.$entry->get_value('mail').'>';
107:       my $problems = join('', map { "$_\n" } map {@$_} values %problems);
108:       my $uri = &$makeurl($entry);
109:       my $message = <<EndMessage;
110: You currently have one or more photos in your directory entry, however
111: there are some problems with it:
112: 
113: $problems
114: 
115: Please go to $uri to fix the
116: problem photos, usually this just involves making them smaller.
117: 
118: Thanks,
119: $adminemail
120: EndMessage
121: 
122:       sendmail(To => $mailto, From => $adminemail,
123: 	       Subject => 'Problems with your photo in the vertex LDAP directory',
124: 	       Message => $message);
125:     }
126:   }
127: }
128: 
129: exit(0);
130: 
131: __END__
132: =head1 NAME
133: 
134: prune_ldap_photos.pl - Removing oversize photos people put into LDAP
135: 
136: =head1 SYNOPSIS
137: 
138:   prune_ldap_photos.pl
139:   prune_ldap_photos.pl -D admindn -d
140: 
141: =head1 DESCRIPTION
142: 
143: This script will search the LDAP directory for people with JPEG photos
144: in their directory entry, and for each photo found it will check that
145: the photo is:
146: 
147: =over 4
148: 
149: =item less than a certain number of bytes long
150: 
151: =item a valid JPEG image
152: 
153: =item a certain number of pixels wide
154: 
155: =item a certain number of pixels high
156: 
157: =back
158: 
159: By default, the entry owner will be sent email (as specified in the
160: 'mail' attribute) describing the problems with their photo. If the
161: B<-d> option is given, then the offending photo will be removed from
162: their entry.
163: 
164: The B<-D> option is used to specify a DN to bind as- typically this is
165: required iff the B<-d> option is used to remove photos.
166: 
167: The B<-w> option can be used to specify the password on the command
168: line, when using the B<-D> option. If B<-w> is not given, the password
169: is prompted for on stdin.
170: 
171: =head1 AUTHOR
172: 
173: Steve Haslam <steve.haslam@excitehome.net>
174: 
175: =cut