Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked
 
PerlMonks  

Delete or warn about oversize photos in an LDAP directory (uses GD and Net::LDAP)

by araqnid (Beadle)
on Apr 05, 2001 at 23:43 UTC ( #70251=perlcraft: print w/ replies, xml ) Need Help??

   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

Comment on Delete or warn about oversize photos in an LDAP directory (uses GD and Net::LDAP)
Download Code
Re: Delete or warn about oversize photos in an LDAP directory (uses GD and Net::LDAP)
by dws (Chancellor) on Apr 06, 2001 at 01:37 UTC
    Useful!

    Unless it's important to verify that the JPEG is valid before doing any other checks, checking the image size before turning the JPEG into a GD::Image saves a few cycles in the "too big" case.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlcraft [id://70251]
Approved by root
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others chilling in the Monastery: (3)
As of 2015-05-26 02:05 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    In my home, the TV remote control is ...









    Results (492 votes), past polls