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