Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses
 
PerlMonks  

comment on

( #3333=superdoc: print w/replies, xml ) Need Help??
    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

In reply to Delete or warn about oversize photos in an LDAP directory (uses GD and Net::LDAP) by araqnid

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others taking refuge in the Monastery: (4)
    As of 2020-12-04 14:18 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?
      How often do you use taint mode?





      Results (60 votes). Check out past polls.

      Notices?