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