Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 302 lines (243 sloc) 7.453 kb
8bcc653 Graham Barr New contrib scripts from Clif Harden
gbarr authored
1 #!/usr/local/bin/perl
2 #
3 #----------------------------------------------------------------------------
4 #
5 # This program was written by Clif Harden.
6 # It uses the PERL LDAP module.
7 # This LDAP module is available from the PERL CPAN
8 # system.
9 #
10 # Purpose: This program is designed to load jpeg file data into a LDAP
11 # directory entry.
12 #
13 #
096bf69 Graham Barr Remove all references to :all as it is not recomended
gbarr authored
14 # $Id: jpegLoad.pl,v 1.2 2003/06/18 18:23:31 gbarr Exp $
8bcc653 Graham Barr New contrib scripts from Clif Harden
gbarr authored
15 #
16 # Revisions:
17 # $Log: jpegLoad.pl,v $
096bf69 Graham Barr Remove all references to :all as it is not recomended
gbarr authored
18 # Revision 1.2 2003/06/18 18:23:31 gbarr
19 # Remove all references to :all as it is not recomended
20 #
8bcc653 Graham Barr New contrib scripts from Clif Harden
gbarr authored
21 # Revision 1.1 2001/03/12 14:01:46 gbarr
22 # New contrib scripts from Clif Harden
23 #
24 #
25 #
26 #
27
28 use strict;
29 use Getopt::Std;
30 use Net::LDAP;
31 use Net::LDAP::Filter;
096bf69 Graham Barr Remove all references to :all as it is not recomended
gbarr authored
32 use Net::LDAP;
8bcc653 Graham Barr New contrib scripts from Clif Harden
gbarr authored
33 use Net::LDAP::Util qw( ldap_error_name ldap_error_text );
34 use Net::LDAP::Constant;
35
36
37 my $errstr = 0;
38 my $errmsg = "";
39
40 $errmsg = ldap_error_text($errstr);
41
42 #
43 # Initialize opt hash.
44 # You can change the defaults to match your setup.
45 # This can eliminate the need for many of the input
46 # options on the command line.
47 #
48 my %opt = (
49 'b' => 'dc=harden,dc=org',
50 'h' => 'localhost',
51 'd' => 0,
52 'D' => 'cn=manager',
53 'w' => 'password',
54 'V' => '3',
55 'a' => 'cn',
56 'v' => 'commonName'
57 );
58
59 if ( @ARGV == 0 )
60 {
61 #
62 # print usage message.
63 #
64 Usage();
65 }
66
67 #
68 # Get command line options.
69 #
70
71 getopts('b:f:h:d:D:w:V:a:v:',\%opt);
72
73
74 if ( !defined( $opt{'f'}) || !-e $opt{'f'} )
75 {
76 #
77 # No jpeg file specified or the file does not exist.
78 #
79 print "$opt{'f'}\n";
80 Usage();
81 }
82
83 $/ = undef;
84 $\ = undef;
85 $, = undef;
86
87 #
88 # Slurp all of the jpeg file in at once.
89 #
90 open(IN, "<$opt{'f'}");
0188e71 Peter Marschall use current methods and parameters, add binmode where necessary
marschap authored
91 binmode(IN);
8bcc653 Graham Barr New contrib scripts from Clif Harden
gbarr authored
92 $_ = <IN>;
93 close(IN);
94
95 #
96 # build filter string
97 #
98 my $match = "( $opt{'a'}=$opt{'v'} )";
99
100 #
101 # create filter object
102 #
103 my $f = Net::LDAP::Filter->new($match) or die "Bad filter '$match'";
104
105 #
106 # make ldap connection to directory.
107 #
108 my $ldap = new Net::LDAP($opt{'h'},
109 timeout => 10,
110 debug => $opt{'d'},
111 ) or die $@;
112
113 #
114 # Bind to directory.
115 #
0188e71 Peter Marschall use current methods and parameters, add binmode where necessary
marschap authored
116 $ldap->bind($opt{'D'}, password => "$opt{'w'}", version => $opt{'V'}) or die $@;
8bcc653 Graham Barr New contrib scripts from Clif Harden
gbarr authored
117
118 #
119 # Search directory for record that matches filter
120 #
121 my $mesg = $ldap->search(
122 base => $opt{'b'},
123 filter => $f,
124 attrs => [ "cn","jpegphoto" ],
125 ) or die $@;
126
127 die $mesg->error,$mesg->code
128 if $mesg->code;
129
130 #
131 # get record entry object
132 #
133 my $entry = $mesg->entry();
134
135 #
136 # get record DN
137 #
138 if ( !defined($entry) )
139 {
140 print "No record for filter $match\n";
141 $ldap->unbind;
142 exit;
143 }
144
145 my $dn = $entry->dn();
146
147 print "\n";
148 print "dn: $dn\n";
149 print "\n";
150
151 #
152 # initialize arrays
153 #
154 my @addMember = ();
155 my @memberChange = ();
156
157 push( @addMember, "jpegphoto" ); # attribute name
158 push( @addMember, $_ ); # attribute value
159
0188e71 Peter Marschall use current methods and parameters, add binmode where necessary
marschap authored
160 my $attr = $entry->get_value("jpegPhoto");
8bcc653 Graham Barr New contrib scripts from Clif Harden
gbarr authored
161 if(ref($attr))
162 {
163 #
164 # Entry already has a jpegPhoto, replace it.
165 #
166 push( @memberChange, "replace" ); # ldap replace operation
167 push( @memberChange, \@addMember ); # ldap data to add
168 }
169 else
170 {
171 #
172 # Entry does not have a jpegPhoto, add it.
173 #
174 push( @memberChange, "add" ); # ldap add operation
175 push( @memberChange, \@addMember ); # ldap data to add
176 }
177
178 $mesg = $ldap->modify( $dn, changes => [ @memberChange ] ) or die $@;
179
180 if ( $mesg->code )
181 {
182 $errstr = $mesg->code;
183 print "Error code: $errstr\n";
184 $errmsg = ldap_error_text($errstr);
185 print "$errmsg\n";
186
187 }
188
189 $ldap->unbind;
190
191 #----------------------------------------#
192 # Usage() - display simple usage message #
193 #----------------------------------------#
194 sub Usage
195 {
196 print( "Usage: [-b] <base> | [-h] <host> | [-d] <number> | [-D] <DN> | [-w] <password> | [-a] <attribute> | [-v] <data> | [-f] <jpeg file> \n" );
197 print( "\t-b Search base.\n" );
198 print( "\t-d Debug mode. Display debug messages to stdout.\n" );
199 print( "\t-D Authenication Distingushed Name.\n" );
200 print( "\t-f JPEG file to load in to attribute jpegPhoto.\n" );
201 print( "\t Required input option.\n" );
202 print( "\t-h LDAP directory host computer.\n" );
203 print( "\t-w Authenication password.\n" );
204 print( "\t-a Attribute that will be incorporated into the search filter.\n" );
205 print( "\t-v Data that will be incorporated into the search filter.\n" );
206 print( "\t-V LDAP version of the LDAP directory.\n" );
207 print( "\n" );
208 print( "\t Perldoc pod documentation is included in this script.\n" );
209 print( "\t To read the pod documentation do the following;\n" );
210 print( "\t perldoc <script name>\n" );
211 print( "\n" );
212 print( "\n" );
213 exit( 1 );
214 }
215
216 __END__
217
218 =head1 NAME
219
220 jpegLoad.pl - A script to load a jpeg picture into the jpegPhoto attribute of a directory entry.
221
222 =head1 SYNOPSIS
223
224 The intent of this script is to show the user how to load a
225 picture that is in jpeg format into the jpegPhoto attribute of
226 a directory entry.
227 The entry in question must have the schema defined to
228 allow the loading of the jpegPhoto attribute.
229
230 This script has been tested on a OpenLDAP 2.0.7 directory server
231 and a Netscape 4.x directory server.
232
233 You may need to change the first line of the PERL jpegLoad.pl script
234 to point to your file pathname of perl.
235
236 =head1 Input options.
237
238 -b Search base.
239 -d Debug mode. Display debug messages to stdout.
240 -D Distingushed Name for authenication purposes.
241 -f JPEG file to load in to attribute jpegPhoto.
242 Required input option and file must exist.
243 -h LDAP directory host computer.
244 -w Authenication password.
245 -a Attribute that will be incorporated into the search filter.
246 -v Data that will be incorporated into the search filter.
247 -V LDAP version of the LDAP directory.
248
249
250 Usage: jpegLoad.pl -b <base> -h <host> -d <number> -D <DN> \
251 -w <password> -a <attribute> -v <data> \
252 -f <jpeg file>
253
254 Inside the script is a opt hash that can be initialized to
255 default values that can eliminate the need for many of the
256 input options on the command line.
257
258 -------------------------------------------------------------------
259
260 =head1 REQUIREMENTS
261
262 To use this program you will need the following.
b5e33d1 Peter Marschall make PODs podchecker-clean
marschap authored
263
8bcc653 Graham Barr New contrib scripts from Clif Harden
gbarr authored
264 At least PERL version 5.004. You can get a stable version of PERL
265 from the following URL;
266 http://cpan.org/src/index.html
b5e33d1 Peter Marschall make PODs podchecker-clean
marschap authored
267
8bcc653 Graham Barr New contrib scripts from Clif Harden
gbarr authored
268 Perl LDAP module. You can get this from the following URL;
269 ftp://ftp.duke.edu/pub/CPAN/modules/by-module/Net/
b5e33d1 Peter Marschall make PODs podchecker-clean
marschap authored
270
8bcc653 Graham Barr New contrib scripts from Clif Harden
gbarr authored
271 Bundled inside each PERL module is instructions on how to install the
272 module into your PERL system.
b5e33d1 Peter Marschall make PODs podchecker-clean
marschap authored
273
8bcc653 Graham Barr New contrib scripts from Clif Harden
gbarr authored
274 -------------------------------------------------------------------
275
276 =head1 INSTALLING THE SCRIPT
277
278 Install the jpegLoad.pl script anywhere you wish, I suggest
279 /usr/local/bin/jpegLoad.pl.
b5e33d1 Peter Marschall make PODs podchecker-clean
marschap authored
280
8bcc653 Graham Barr New contrib scripts from Clif Harden
gbarr authored
281 -------------------------------------------------------------------
b5e33d1 Peter Marschall make PODs podchecker-clean
marschap authored
282
8bcc653 Graham Barr New contrib scripts from Clif Harden
gbarr authored
283 Since the script is in PERL, feel free to modify it if it does not
284 meet your needs. This is one of the main reasons I did it in PERL.
285 If you make an addition to the code that you feel other individuals
286 could use let me know about it. I may incorporate your code
287 into my code.
288
289 =head1 AUTHOR
290
291 Clif Harden <charden@pobox.com>
292 If you find any errors in the code please let me know at
293 charden@pobox.com.
294
295 =head1 COPYRIGHT
296
297 Copyright (c) 2001 Clif Harden. All rights reserved. This program is
298 free software; you can redistribute it and/or modify it under the same
299 terms as Perl itself.
300
301 =cut
Something went wrong with that request. Please try again.