You can subscribe to this list here.
2001 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
(9) |
Nov
(4) |
Dec
(15) |
---|---|---|---|---|---|---|---|---|---|---|---|---|
2002 |
Jan
(23) |
Feb
(18) |
Mar
(11) |
Apr
(3) |
May
(23) |
Jun
(13) |
Jul
(16) |
Aug
(11) |
Sep
(5) |
Oct
(4) |
Nov
(2) |
Dec
(4) |
2003 |
Jan
(18) |
Feb
(13) |
Mar
(56) |
Apr
(3) |
May
(124) |
Jun
(21) |
Jul
(2) |
Aug
(8) |
Sep
(1) |
Oct
(23) |
Nov
(4) |
Dec
(2) |
2004 |
Jan
(18) |
Feb
(5) |
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
From: Graham B. <gb...@us...> - 2002-06-03 15:26:52
|
Update of /cvsroot/perl-ldap/ldap/lib/Net/LDAP In directory usw-pr-cvs1:/tmp/cvs-serv27465/lib/Net/LDAP Modified Files: Search.pm Util.pm Log Message: New implementation of canonical_dn and ldap_explode_dn, thanks to Norbert Klasen Index: Search.pm =================================================================== RCS file: /cvsroot/perl-ldap/ldap/lib/Net/LDAP/Search.pm,v retrieving revision 1.6 retrieving revision 1.7 diff -u -d -r1.6 -r1.7 --- Search.pm 11 Jun 2001 16:35:29 -0000 1.6 +++ Search.pm 3 Jun 2002 15:26:46 -0000 1.7 @@ -12,7 +12,7 @@ use Net::LDAP::Constant qw(LDAP_SUCCESS LDAP_DECODING_ERROR); @ISA = qw(Net::LDAP::Message); -$VERSION = "0.07"; +$VERSION = "0.08"; sub first_entry { # compat @@ -131,9 +131,9 @@ $i++; } - $v ||= ($a->[1] ||= Net::LDAP::Util::canonical_dn( $a->[0]->dn, 1)) + $v ||= ($a->[1] ||= Net::LDAP::Util::canonical_dn( $a->[0]->dn, reverse => 1, separator => "\0")) cmp - ($b->[1] ||= Net::LDAP::Util::canonical_dn( $b->[0]->dn, 1)); + ($b->[1] ||= Net::LDAP::Util::canonical_dn( $b->[0]->dn, reverse => 1, separator => "\0")); } map { [ $_ ] } @{$self->{entries}}; } Index: Util.pm =================================================================== RCS file: /cvsroot/perl-ldap/ldap/lib/Net/LDAP/Util.pm,v retrieving revision 1.14 retrieving revision 1.15 diff -u -d -r1.14 -r1.15 --- Util.pm 31 Jan 2002 15:25:52 -0000 1.14 +++ Util.pm 3 Jun 2002 15:26:46 -0000 1.15 @@ -1,6 +1,7 @@ -# Copyright (c) 1999-2000 Graham Barr <gb...@po...>. All rights reserved. -# This program is free software; you can redistribute it and/or -# modify it under the same terms as Perl itself. +# Copyright (c) 1999-2002 Graham Barr <gb...@po...> and +# Norbert Klasen <nor...@da...> All Rights Reserved. +# This program is free software; you can redistribute it and/or modify +# it under the same terms as Perl itself. package Net::LDAP::Util; @@ -40,7 +41,7 @@ canonical_dn ldap_explode_dn ); -$VERSION = "0.08"; +$VERSION = "0.09"; =item ldap_error_name ( NUM ) @@ -225,168 +226,294 @@ -=item canonical_dn ( DN [, FOR_SORT ]) -Returns the given DN in a canonical form. Returns undef if DN is -not a valid Distinguished Name -If FOR_SORT is specified and is a I<true> value, the the DNs returned -will have their RDN components in reverse order. This is primarily -used for sorting. +=item canonical_dn ( DN [ , OPTIONS ] ) -It performs the following operations on the given DN +Returns the given B<DN> in a canonical form. Returns undef if B<DN> is +not a valid Distinguished Name. (Note: The empty string "" is a valid DN.) +B<DN> can either be a string or reference to an array of hashes as returned by +ldap_explode_dn, which is useful when constructing a DN. + +It performs the following operations on the given B<DN>: =over 4 =item * -Lowercases values that are # followed by hex. +Removes the leading 'OID.' characters if the type is an OID instead +of a name. =item * -Uppercases type names. +Escapes all RFC 2253 special characters (",", "+", """, "\", "<", ">", +";", "#", "=", " "), slashes ("/"), and any other character where the +ASCII code is <32 as \hexpair. =item * -Removes the leading OID. characters if the type is an OID instead -of a name. +Converts all leading and trailing spaces in values to be \20. =item * -Escapes all RFC 2253 special characters, and any other character -where the ASCII code is <32 or >= 127, with a backslash and a two -digit hex code. +If an RDN contains multiple parts, the parts are re-ordered so that +the attribute type names are in alphabetical order. -=item * +=back -Converts all leading and trailing spaces in values to be \20. +B<OPTIONS> is a list of name/value pairs, valid options are: -=item * +=over 4 -If an RDN contains multiple parts, the parts are re-ordered so that -the attribute names are in alphabetical order. +=item casefold + +Controls case folding of attribute type names. Attribute values are not +affected by this option. The default is to uppercase. Valid values are: + +=over 4 + +=item lower + +Lowercase attribute type names. + +=item upper + +Uppercase attribute type names. This is the default. + +=item none + +Do not change attribute type names. =back -B<Note> values that are hex encoded (ie start with a #) are not -decoded. So C<SN=Barr> is not treated the same as C<SN=#42617272> +=item mbcescape -=cut +If TRUE, characters that are encoded as a multi-octet UTF-8 sequence +will be escaped as \(hexpair){2,*}. +=item reverse -sub canonical_dn { - my ($dn, $rev) = @_; - my @dn = ldap_explode_dn($dn) or return undef; +If TRUE, the RDN sequence is reversed. - my($comma, $plus) = $rev ? ("\000","\001") : (",", "+"); +=item separator - join($comma, +Separator to use between RDNs. Defaults to comma (','). + +=back + +=cut + +sub canonical_dn($%) { + my ($dn, %opt) = @_; + + return $dn unless defined $dn and $dn ne ''; + + # create array of hash representation + my $rdns = ref($dn) eq 'ARRAY' + ? $dn + : ldap_explode_dn( $dn ) + or return undef; #error condition + + # assign specified or default separator value + my $separator = $opt{separator} || ','; + + # flatten all RDNs into strings + my @flatrdns = map { - my $h = $_; - my @t = sort keys %$h; - join($plus, - map { - "$_=$h->{$_}"; - } $rev ? reverse(@t) : @t) - } $rev ? reverse(@dn) : @dn); + my $rdn = $_; + my @types = sort keys %$rdn; + join('+', + map { + my $val = $rdn->{$_}; + + if ( ref($val) ) { + $val = '#' . unpack("H*", $$val); + } else { + #escape insecure characters and optionally MBCs + if ( $opt{mbcescape} ) { + $val =~ s/([\x00-\x1f\/\\",=+<>#;\x7f-\xff])/ + sprintf("\\%02x",ord($1))/xeg; + } else { + $val =~ s/([\x00-\x1f\/\\",=+<>#;])/ + sprintf("\\%02x",ord($1))/xeg; + } + #escape leading and trailing whitespace + $val =~ s/(^\s+|\s+$)/ + "\\20" x length $1/xeg; + } + + # case fold attribute type and create return value + if ( !$opt{casefold} || $opt{casefold} eq 'upper' ) { + (uc $_)."=$val"; + } elsif ( $opt{casefold} eq 'lower' ) { + (lc $_)."=$val"; + } else { + "$_=$val"; + } + } @types); + } @$rdns; + # join RDNs into string, optionally reversing order + $opt{reverse} + ? join($separator, reverse @flatrdns) + : join($separator, @flatrdns); } -=item ldap_explode_dn ( DN ) - -Explodes the given DN into a list of hashes. Each RDN will be -a separate element in the list returned. +=item ldap_explode_dn ( DN [ , OPTIONS ] ) -Each RDN is returned as a hash. +Explodes the given B<DN> into an array of hashes and returns a reference to this +array. Returns undef if B<DN> is not a valid Distinguished Name. -Returns the empty list if DN is -not a valid Distinguished Name +A Distinguished Name is a sequence of Relative Distingushed Names (RDNs), which +themselves are sets of Attributes. For each RDN a hash is constructed with the +attribute type names as keys and the attribute values as corresponding values. +These hashes are then strored in an array in the order in which they appear +in the DN. -It also performs the following operations on the given DN +For example, the DN 'OU=Sales+CN=J. Smith,DC=example,DC=net' is exploded to: +[ + { + 'OU' => 'Sales', + 'CN' => 'J. Smith' + }, + { + 'DC' => 'example' + }, + { + 'DC' => 'net' + } +] -=over 4 +(RFC2253 string) DNs might also contain values, which are the bytes of the +BER encoding of the X.500 AttributeValue rather than some LDAP string syntax. +These values are hex-encoded and prefixed with a #. To distingush such BER +values, ldap_explode_dn uses references to the actual values, +e.g. '1.3.6.1.4.1.1466.0=#04024869,DC=example,DC=com' is exploded to: +[ + { + '1.3.6.1.4.1.1466.0' => \"\004\002Hi" + }, + { + 'DC' => 'example' + }, + { + 'DC' => 'com' + } +]; -=item * +It also performs the following operations on the given DN: -Lowercases values that are # followed by hex. +=over 4 =item * -Uppercases type names. +Unescape "\" followed by ",", "+", """, "\", "<", ">", ";", "#", "=", +" ", or a hexpair and and strings beginning with "#". =item * Removes the leading OID. characters if the type is an OID instead of a name. -=item * +=back -Escapes all RFC 2253 special characters, and any other character -where the ASCII code is <32 or >= 127, with a backslash and a two -digit hex code. +B<OPTIONS> is a list of name/value pairs, valid options are: -=item * +=over 4 -Converts all leading and trailing spaces in values to be \20. +=item casefold -=back +Controls case folding of attribute types names. Attribute values are not +affected by this option. The default is to uppercase. Valid values are: + +=over 4 -B<Note> values that are hex encoded (ie start with a #) are not -decoded. So C<SN=Barr> is not treated the same as C<SN=#42617272> +=item lower -=cut +Lowercase attribute types names. +=item upper -sub ldap_explode_dn { - my ($dn) = @_; +Uppercase attribute type names. This is the default. + +=item none + +Do not change attribute type names. + +=item reverse + +If TRUE, the RDN sequence is reversed. + +=back + +=cut + +sub ldap_explode_dn($%) { + my ($dn, %opt) = @_; + return undef unless defined $dn; + return [] if $dn eq ''; my (@dn, %rdn); while ( - $dn =~ /\G(?: - \s* - ([a-zA-Z][-a-zA-Z0-9]*|(?:[Oo][Ii][Dd]\.)?\d+(?:\.\d+)*) - \s* - = - \s* - ( - (?:[^\\",=+<>\#;]*[^\\",=+<>\#;\s]|\\(?:[\\ ",=+<>#;]|[0-9a-fA-F]{2}))* - | - \#(?:[0-9a-fA-F]{2})+ - | - "(?:[^\\"]+|\\(?:[\\",=+<>#;]|[0-9a-fA-F]{2}))*" - ) - \s* - (?:([;,+])\s*(?=\S)|$) - )\s*/gcx) + $dn =~ /\G(?: + \s* + ([a-zA-Z][-a-zA-Z0-9]*|(?:[Oo][Ii][Dd]\.)?\d+(?:\.\d+)*) + \s* + = + \s* + ( + (?:[^\\",=+<>\#;]*[^\\",=+<>\#;\s]|\s*\\(?:[\\ ",=+<>#;]|[0-9a-fA-F]{2}))* + | + \#(?:[0-9a-fA-F]{2})+ + | + "(?:[^\\"]+|\\(?:[\\",=+<>#;]|[0-9a-fA-F]{2}))*" + ) + \s* + (?:([;,+])\s*(?=\S)|$) + )\s*/gcx) { my($type,$val,$sep) = ($1,$2,$3); - $type =~ s/^oid\.(\d+(\.\d+)*)$/$1/i; + $type =~ s/^oid\.(\d+(\.\d+)*)$/$1/i; #remove leading "oid." - if ($val !~ /^#/) { + if ( !$opt{casefold} || $opt{casefold} eq 'upper' ) { + $type = uc $type; + } elsif ( $opt{casefold} eq 'lower' ) { + $type = lc($type); + } + + if ( $val =~ s/^#// ) { + # decode hex-encoded BER value + my $tmp = pack('H*', $val); + $val = \$tmp; + } else { + # remove quotes $val =~ s/^"(.*)"$/$1/; - $val =~ s/\\([\\ ",=+<>#;]|[0-9a-fA-F]{2}) - /length($1)==1 ? $1 : chr(hex($1)) - /xeg; - $val =~ s/([\\",=+<>#;])/\\$1/g; - $val =~ s/([\x00-\x1f\x7f-\xff])/sprintf("\\%02x",ord($1))/eg; - $val =~ s/(^\s+|\s+$)/"\\20" x length $1/ge; + # unescape characters + $val =~ s/\\([\\ ",=+<>#;]|[0-9a-fA-F]{2}) + /length($1)==1 ? $1 : chr(hex($1)) + /xeg; } - $rdn{uc $type} = $val; + $rdn{$type} = $val; unless (defined $sep and $sep eq '+') { - push @dn, { %rdn }; + if ( $opt{reverse} ) { + unshift @dn, { %rdn }; + } else { + push @dn, { %rdn }; + } %rdn = (); } } - (length($dn) != (pos($dn)||0)) - ? () - : @dn; + length($dn) == (pos($dn)||0) + ? \@dn + : undef; } + =back =head1 AUTHOR @@ -395,9 +522,13 @@ =head1 COPYRIGHT -Copyright (c) 1999-2000 Graham Barr. All rights reserved. This program is +Copyright (c) 1999-2002 Graham Barr. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +ldap_explode_dn and canonical_dn also + +(c) 2002 Norbert Klasen, nor...@da..., All Rights Reserved. =for html <hr> |
From: Clif H. <ch...@us...> - 2002-06-01 02:23:42
|
Update of /cvsroot/perl-ldap/website In directory usw-pr-cvs1:/tmp/cvs-serv21843/website Modified Files: index.html Log Message: Correct a minor html format error. Index: index.html =================================================================== RCS file: /cvsroot/perl-ldap/website/index.html,v retrieving revision 1.15 retrieving revision 1.16 diff -u -d -r1.15 -r1.16 --- index.html 1 Jun 2002 02:21:10 -0000 1.15 +++ index.html 1 Jun 2002 02:23:40 -0000 1.16 @@ -112,8 +112,7 @@ <hr> -<H2>LDAP RFC(s)</H2> -<A HREF="rfc.html">online</A>. +<H2>LDAP RFC(s) <A HREF="rfc.html">online</A>.</H2> <hr> <p> |
From: Clif H. <ch...@us...> - 2002-06-01 02:21:13
|
Update of /cvsroot/perl-ldap/website In directory usw-pr-cvs1:/tmp/cvs-serv21320/website Modified Files: index.html Log Message: Added rfc list web page. Index: index.html =================================================================== RCS file: /cvsroot/perl-ldap/website/index.html,v retrieving revision 1.14 retrieving revision 1.15 diff -u -d -r1.14 -r1.15 --- index.html 9 Nov 2001 05:03:04 -0000 1.14 +++ index.html 1 Jun 2002 02:21:10 -0000 1.15 @@ -112,6 +112,12 @@ <hr> +<H2>LDAP RFC(s)</H2> +<A HREF="rfc.html">online</A>. + +<hr> +<p> + <H2>FAQ</H2> The latest released FAQ is available <A HREF="FAQ.html">online</A>. |
From: Graham B. <gb...@us...> - 2002-05-31 15:16:47
|
Update of /cvsroot/perl-ldap/ldap In directory usw-pr-cvs1:/tmp/cvs-serv4938 Modified Files: MANIFEST Log Message: Add missing file data/00-cmp.ldif to CVS and MANIFEST Index: MANIFEST =================================================================== RCS file: /cvsroot/perl-ldap/ldap/MANIFEST,v retrieving revision 1.17 retrieving revision 1.18 diff -u -d -r1.17 -r1.18 --- MANIFEST 18 Feb 2002 16:51:41 -0000 1.17 +++ MANIFEST 31 May 2002 15:16:44 -0000 1.18 @@ -20,6 +20,7 @@ contrib/ldifsort.pl contrib/printMembers.pl contrib/tklkup +data/00-cmp.ldif data/00-cmp2.ldif data/00-in.ldif data/50-cmp.ldif @@ -42,33 +43,6 @@ data/slapd.at.conf data/slapd.oc.conf data/slapd2-conf.in -htdocs/Bundle/Net/LDAP.html -htdocs/Net/LDAP.html -htdocs/Net/LDAP/Constant.html -htdocs/Net/LDAP/Control.html -htdocs/Net/LDAP/Control/Paged.html -htdocs/Net/LDAP/Control/ProxyAuth.html -htdocs/Net/LDAP/Control/Sort.html -htdocs/Net/LDAP/Control/SortResult.html -htdocs/Net/LDAP/Control/VLV.html -htdocs/Net/LDAP/Control/VLVResponse.html -htdocs/Net/LDAP/DSML.html -htdocs/Net/LDAP/Entry.html -htdocs/Net/LDAP/Examples.html -htdocs/Net/LDAP/Extra.html -htdocs/Net/LDAP/FAQ.html -htdocs/Net/LDAP/Filter.html -htdocs/Net/LDAP/LDIF.html -htdocs/Net/LDAP/Message.html -htdocs/Net/LDAP/RFC.html -htdocs/Net/LDAP/Reference.html -htdocs/Net/LDAP/Schema.html -htdocs/Net/LDAP/Search.html -htdocs/Net/LDAP/Security.html -htdocs/Net/LDAP/Util.html -htdocs/Net/LDAPS.html -htdocs/index.html -htdocs/index.xml install-nomake lib/Bundle/Net/LDAP.pm lib/LWP/Protocol/ldap.pm @@ -86,7 +60,6 @@ lib/Net/LDAP/Control/VLV.pm lib/Net/LDAP/Control/VLVResponse.pm lib/Net/LDAP/DSML.pm -lib/Net/LDAP/DSML/Parser.pm lib/Net/LDAP/Entry.pm lib/Net/LDAP/Entry.pod lib/Net/LDAP/Examples.pod @@ -108,8 +81,6 @@ lib/Net/LDAP/Security.pod lib/Net/LDAP/Util.pm lib/Net/LDAPS.pm -mkhtml -mkindex mkmanf t/00ldif-entry.t t/01canon_dn.t |
From: Graham B. <gb...@us...> - 2002-05-31 15:16:47
|
Update of /cvsroot/perl-ldap/ldap/data In directory usw-pr-cvs1:/tmp/cvs-serv4938/data Added Files: 00-cmp.ldif Log Message: Add missing file data/00-cmp.ldif to CVS and MANIFEST --- NEW FILE: 00-cmp.ldif --- dn: o=University of Michigan, c=US objectclass: top objectclass: organization objectclass: domainRelatedObject objectclass: quipuObject objectclass: quipuNonLeafObject l: Ann Arbor, Michigan st: Michigan streetaddress: 535 West William St. o: University of Michigan o: UMICH o: UM o: U-M o: U of M description: The University of Michigan at Ann Arbor postaladdress: University of Michigan $ 535 W. William St. $ Ann Arbor, MI 481 09 $ USpostalcode: 48109 telephonenumber: +1 313 764-1817 lastmodifiedtime: 930106182800Z lastmodifiedby: cn=manager, o=university of michigan, c=US associateddomain: umich.edu dn: ou=People, o=University of Michigan, c=US objectclass: top objectclass: organizationalUnit objectclass: quipuObject objectclass: quipuNonLeafObject ou: People dn: ou=Groups, o=University of Michigan, c=US objectclass: top objectclass: organizationalUnit objectclass: quipuObject objectclass: quipuNonLeafObject ou: Groups lastmodifiedtime: 950120182331Z lastmodifiedby: cn=manager, o=university of michigan, c=US dn: ou=Alumni Association, ou=People, o=University of Michigan, c=US objectclass: top objectclass: organizationalUnit objectclass: quipuObject objectclass: quipuNonLeafObject ou: Alumni Association dn: ou=Information Technology Division, ou=People, o=University of Michigan, c =US objectclass: top objectclass: organizationalUnit objectclass: quipuObject objectclass: quipuNonLeafObject ou: Information Technology Divisio dn: cn=All Staff,ou=Groups,o=University of Michigan,c=US member: cn=Manager, o=University of Michigan, c=US member: cn=Barbara Jensen, ou=Information Technology Division, ou=People, o=Un iversity of Michigan, c=US member: cn=Jane Doe, ou=Alumni Association, ou=People, o=University of Michiga n, c=US member: cn=John Doe, ou=Information Technology Division, ou=People, o=Universi ty of Michigan, c=US member: cn=Mark Elliot, ou=Alumni Association, ou=People, o=University of Mich igan, c=US member: cn=James A Jones 1, ou=Alumni Association, ou=People, o=University of Michigan, c=US member: cn=James A Jones 2, ou=Information Technology Division, ou=People, o=U niversity of Michigan, c=US member: cn=Jennifer Smith, ou=Alumni Association, ou=People, o=University of M ichigan, c=US member: cn=Dorothy Stevens, ou=Alumni Association, ou=People, o=University of Michigan, c=US member: cn=Ursula Hampster, ou=Alumni Association, ou=People, o=University of Michigan, c=US member: cn=Bjorn Jensen, ou=Information Technology Division, ou=People, o=Univ ersity of Michigan, c=US associateddomain: umich.edu requeststo: cn=Manager, o=University of Michigan, c=US errorsto: cn=Manager, o=University of Michigan, c=US owner: cn=Manager, o=University of Michigan, c=US cn: All Staff joinable: FALSE multi-linedescription: Everyone in the sample data objectclass: rfc822mailgroup |
From: Graham B. <gb...@us...> - 2002-05-29 11:02:07
|
Update of /cvsroot/perl-ldap/ldap/lib/Net/LDAP In directory usw-pr-cvs1:/tmp/cvs-serv5074/lib/Net/LDAP Modified Files: LDIF.pm Log Message: Handle the case where the version spec is by itself Index: LDIF.pm =================================================================== RCS file: /cvsroot/perl-ldap/ldap/lib/Net/LDAP/LDIF.pm,v retrieving revision 1.16 retrieving revision 1.17 diff -u -d -r1.16 -r1.17 --- LDIF.pm 23 Apr 2002 10:52:55 -0000 1.16 +++ LDIF.pm 29 May 2002 11:02:04 -0000 1.17 @@ -9,7 +9,7 @@ require Net::LDAP::Entry; use vars qw($VERSION); -$VERSION = "0.11"; +$VERSION = "0.12"; my %mode = qw(w > r < a >>); @@ -109,6 +109,8 @@ if (@ldif and $ldif[0] =~ /^version:\s+(\d+)/) { $self->{version} = $1; shift @ldif; + return $self->_read_entry + unless @ldif; } if (@ldif <= 1) { |
From: Clif H. <ch...@us...> - 2002-05-29 02:47:40
|
Update of /cvsroot/perl-ldap/ldap/lib/Net/LDAP In directory usw-pr-cvs1:/tmp/cvs-serv19542/ldap/lib/Net/LDAP Modified Files: DSML.pm Log Message: Initial attempt at putting POD documentation in the DSML.pm module. Index: DSML.pm =================================================================== RCS file: /cvsroot/perl-ldap/ldap/lib/Net/LDAP/DSML.pm,v retrieving revision 1.13 retrieving revision 1.14 diff -u -d -r1.13 -r1.14 --- DSML.pm 28 May 2002 07:52:25 -0000 1.13 +++ DSML.pm 29 May 2002 02:47:37 -0000 1.14 @@ -1,6 +1,9 @@ - package Net::LDAP::DSML; +# +# $Id$ +# + use strict; use vars qw(@ISA); use Carp; @@ -669,4 +672,197 @@ } 1; + +__END__ + +=head1 NAME + +NET::LDAP::DSML -- A DSML Writer for Net::LDAP + +=head1 SYNOPSIS + + For a directory entry; + + use Net::LDAP; + use Net::LDAP::DSML; + use IO::File; + + + my $server = "localhost"; + my $file = "testdsml.xml"; + my $ldap = Net::LDAP->new($server); + + $ldap->bind(); + + + # + # For file i/o + # + my $file = "testdsml.xml"; + + my $io = IO::File->new($file,"w") or die ("failed to open $file as filehandle.$!\n"); + + my $dsml = Net::LDAP::DSML->new(output => $io, pretty_print => 1 ) + or die ("DSML object creation problem using an output file.\n"); + # OR + # + # For file i/o + # + + open (IO,">$file") or die("failed to open $file.$!"); + + my $dsml = Net::LDAP::DSML->new(output => *IO, pretty_print => 1) + or die ("DSML object creation problem using an output file.\n"); + + # OR + # + # For array usage. + # Pass a reference to an array. + # + + my @data = (); + $dsml = Net::LDAP::DSML->new(output => \@data, pretty_print => 1) + or die ("DSML object cration problem using an output array.\n"); + + + my $mesg = $ldap->search( + base => 'o=airius.com', + scope => 'sub', + filter => 'ou=accounting', + callback => sub { + my ($mesg,$entry) =@_; + $dsml->write_entry($entry) + if (ref $entry eq 'Net::LDAP::Entry'); + } + ); + + die ("search failed with ",$mesg->code(),"\n") if $mesg->code(); + + For directory schema; + + A file or array can be used for output, in the following example + only an array will be used. + + my $schema = $ldap->schema(); + my @data = (); + my $dsml = Net::LDAP::DSML->new(output => \@data, pretty_print => 1 ) + or die ("DSML object creation problem using an output array.\n"); + + $dsml->write_schema($schema); + + print "Finished printing DSML\n"; + +=head1 DESCRIPTION + +Directory Service Markup Language (DSML) is the XML standard for +representing directory service information in XML. + +At the moment this module only writes DSML entry and schema entities. +Reading DSML entities is a future project. + +Eventually this module will be a full level 2 consumer and producer +enabling you to give you full DSML conformance. Currently this +module has the ability to be a level 2 producer. The user must +understand the his/her directory server will determine the +consumer and producer level they can achieve. + +To determine conformance, it is useful to divide DSML documents into +four types: + + 1.Documents containing no directory schema nor any references to + an external schema. + 2.Documents containing no directory schema but containing at + least one reference to an external schema. + 3.Documents containing only a directory schema. + 4.Documents containing both a directory schema and entries. + +A producer of DSML must be able to produce documents of type 1. +A producer of DSML may, in addition, be able to produce documents of +types 2 thru 4. + +A producer that can produce documents of type 1 is said to be a level +1 producer. A producer than can produce documents of all four types is +said to be a level 2 producer. + +=head1 CALLBACKS + +The module uses callbacks to improve performance (at least the appearance +of improving performance ;) and to reduce the amount of memory required to +parse large DSML files. Every time a single entry or schema is processed +we pass the Net::LDAP object (either an Entry or Schema object) to the +callback routine. + +=head1 CONSTRUCTOR + +new () +Creates a new Net::LDAP::DSML object. There are 3 options +to this method. + +B<Example> + + my $dsml = Net::LDAP::DSML->new(); + Prints xml data to standard out. + + my $dsml = Net::LDAP::DSML->new(output => \@array); + my $dsml = Net::LDAP::DSML->new(output => *FILE); + Prints xml data to a file or array. + + my $dsml = Net::LDAP::DSML->new(output => \@array, pretty_print => 1); + my $dsml = Net::LDAP::DSML->new(output => *FILE, pretty_print => 1); + Prints xml data to a file or array in pretty print style. + + +OUTPUT is a referrence to either a file handle that has already +been opened or to an array. + +PRETTY_PRINT is an option to print a new line at the end of +each element sequence. It makes the reading of the XML output +easier for a human. + + +=head1 METHODS + +=over 4 + +=item write_entry( ENTRY ) + +Entry is a Net::LDAP::Entry object. The write method will parse +the LDAP data in the Entry object and put it into DSML XML +format. + +B<Example> + + my $entry = $mesg->entry(); + $dsml->write_entry($entry); + +=item write_schema( SCHEMA ) + +Schema is a Net::LDAP::Schema object. The write_schema method will +parse the LDAP data in the Schema object and put it into DSML XML +format. + +B<Example> + + my $schema = $ldap->schema(); + $dsml->write_schema($schema); + +=back 4 + +=head1 AUTHOR + +Graham Barr gb...@po... + +=head1 SEE ALSO + +L<Net::LDAP>, +L<XML::Parser> + +=head1 COPYRIGHT + +Copyright (c) 2002 Graham Barr. All rights reserved. This program is +free software; you can redistribute it and/or modify it under the same +terms as Perl itself. + +=cut + |
From: Graham B. <gb...@us...> - 2002-05-28 14:34:04
|
Update of /cvsroot/perl-ldap/sasl/lib/Authen In directory usw-pr-cvs1:/tmp/cvs-serv1796/lib/Authen Modified Files: SASL.pm Log Message: Release 2.02 Index: SASL.pm =================================================================== RCS file: /cvsroot/perl-ldap/sasl/lib/Authen/SASL.pm,v retrieving revision 1.3 retrieving revision 1.4 diff -u -d -r1.3 -r1.4 --- SASL.pm 31 Mar 2002 14:39:32 -0000 1.3 +++ SASL.pm 28 May 2002 14:22:48 -0000 1.4 @@ -8,7 +8,7 @@ use vars qw($VERSION @Plugins); use Carp; -$VERSION = "2.01"; +$VERSION = "2.02"; @Plugins = qw( Authen::SASL::Cyrus |
From: Graham B. <gb...@us...> - 2002-05-28 14:34:03
|
Update of /cvsroot/perl-ldap/sasl/lib/Authen/SASL/Perl In directory usw-pr-cvs1:/tmp/cvs-serv20472/lib/Authen/SASL/Perl Added Files: LOGIN.pm Log Message: Add LOGIN mechanism commonly used by SMTP --- NEW FILE: LOGIN.pm --- # Copyright (c) 2002 Graham Barr <gb...@po...>. All rights reserved. # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. package Authen::SASL::Perl::LOGIN; use strict; use vars qw($VERSION @ISA); $VERSION = "1.00"; @ISA = qw(Authen::SASL::Perl); my %secflags = ( noanonymous => 1, ); sub _secflags { shift; scalar grep { $secflags{$_} } @_; } sub mechanism { 'LOGIN' } sub client_start { my $self = shift; $self->_call('user'); } sub client_step { my ($self, $string) = @_; $string =~ /password/i ? $self->_call('pass') : ''; } 1; |
From: Graham B. <gb...@us...> - 2002-05-28 14:34:00
|
Update of /cvsroot/perl-ldap/sasl In directory usw-pr-cvs1:/tmp/cvs-serv20472 Modified Files: MANIFEST Log Message: Add LOGIN mechanism commonly used by SMTP Index: MANIFEST =================================================================== RCS file: /cvsroot/perl-ldap/sasl/MANIFEST,v retrieving revision 1.2 retrieving revision 1.3 diff -u -d -r1.2 -r1.3 --- MANIFEST 28 Jan 2002 19:52:25 -0000 1.2 +++ MANIFEST 28 May 2002 13:36:24 -0000 1.3 @@ -12,6 +12,7 @@ lib/Authen/SASL/Perl/ANONYMOUS.pm lib/Authen/SASL/Perl/CRAM_MD5.pm lib/Authen/SASL/Perl/EXTERNAL.pm +lib/Authen/SASL/Perl/LOGIN.pm lib/Authen/SASL/Perl/PLAIN.pm t/anon.t t/callback.t |
From: Graham B. <gb...@us...> - 2002-05-28 14:33:59
|
Update of /cvsroot/perl-ldap/sasl In directory usw-pr-cvs1:/tmp/cvs-serv2175 Modified Files: ChangeLog Log Message: Release 2.02 Index: ChangeLog =================================================================== RCS file: /cvsroot/perl-ldap/sasl/ChangeLog,v retrieving revision 1.2 retrieving revision 1.3 diff -u -d -r1.2 -r1.3 --- ChangeLog 31 Mar 2002 14:40:15 -0000 1.2 +++ ChangeLog 28 May 2002 14:23:07 -0000 1.3 @@ -1,3 +1,15 @@ +2002-05-28 15:22 Graham Barr + + * lib/Authen/SASL.pm: + + Release 2.02 + +2002-05-28 14:36 Graham Barr + + * MANIFEST, lib/Authen/SASL/Perl/LOGIN.pm: + + Add LOGIN mechanism commonly used by SMTP + 2002-03-31 15:39 Graham Barr * lib/Authen/SASL.pm: |
From: Chris R. <chr...@us...> - 2002-05-28 11:16:08
|
Update of /cvsroot/perl-ldap/ldap/lib/Net In directory usw-pr-cvs1:/tmp/cvs-serv29078 Modified Files: LDAP.pod Log Message: Added decryptkey parameter Index: LDAP.pod =================================================================== RCS file: /cvsroot/perl-ldap/ldap/lib/Net/LDAP.pod,v retrieving revision 1.14 retrieving revision 1.15 diff -u -d -r1.14 -r1.15 --- LDAP.pod 24 Oct 2001 12:37:14 -0000 1.14 +++ LDAP.pod 28 May 2002 11:16:05 -0000 1.15 @@ -724,12 +724,25 @@ =item clientkey +=item decryptkey + If you want to use the client to offer a certificate to the server for SSL authentication (which is not the same as for the LDAP Bind operation) then set clientcert to the user's certificate file, and clientkey to the user's private key file. These files must be in PEM format. +If the private key is encrypted (highly recommended!) then set +decryptkey to a reference to a subroutine that returns the decrypting +key. For example: + + $ldap = new Net::LDAP('myhost.example.com', version => 3); + $ldap->start_tls(verify => 'require', + clientcert => 'mycert.pem', + clientkey => 'mykey.pem', + decryptkey => sub { 'secret'; }, + capath => '/usr/local/cacerts/'); + =item capath =item cafile @@ -740,8 +753,8 @@ server's certificate. These certificates must all be in PEM format. The directory in 'capath' must contain certificates named using the -hash value of themselves. To generate these names, use OpenSSL like -this in Unix: +hash value of the certificates' subject names. To generate these +names, use OpenSSL like this in Unix: ln -s cacert.pem `openssl x509 -hash -noout < cacert.pem`.0 @@ -852,8 +865,8 @@ This document is based on a document originally written by Russell Fulton <r.f...@au...>. -Chris Ridd @isode.com for the many hours spent testing and contribution -of the ldap* command line utilities. +Chris Ridd <chr...@me...> for the many hours spent +testing and contribution of the ldap* command line utilities. =head1 AUTHOR |
From: Chris R. <chr...@us...> - 2002-05-28 11:15:33
|
Update of /cvsroot/perl-ldap/ldap/lib/Net In directory usw-pr-cvs1:/tmp/cvs-serv28277 Modified Files: LDAPS.pm Log Message: Added decryptkey parameter Index: LDAPS.pm =================================================================== RCS file: /cvsroot/perl-ldap/ldap/lib/Net/LDAPS.pm,v retrieving revision 1.11 retrieving revision 1.12 diff -u -d -r1.11 -r1.12 --- LDAPS.pm 1 Oct 2001 10:28:37 -0000 1.11 +++ LDAPS.pm 28 May 2002 11:15:29 -0000 1.12 @@ -1,11 +1,11 @@ -# Copyright (c) 2000-2001 Chris Ridd <chr...@me...> and +# Copyright (c) 2000-2002 Chris Ridd <chr...@me...> and # Graham Barr <gb...@po...>. All rights reserved. This program is # free software; you can redistribute it and/or modify it under the # same terms as Perl itself. package Net::LDAPS; @Net::LDAPS::ISA = ( 'Net::LDAP' ); -$Net::LDAPS::VERSION = "0.03"; +$Net::LDAPS::VERSION = "0.04"; use strict; use Net::LDAP; @@ -30,7 +30,7 @@ my $arg = shift; my $verify = 0; - my ($clientcert,$clientkey); + my ($clientcert,$clientkey,$passwdcb); if (exists $arg->{'verify'}) { my $v = lc $arg->{'verify'}; @@ -47,11 +47,16 @@ } } + if (exists $arg->{'keydecrypt'}) { + $passwdcb = $arg->{'keydecrypt'}; + } + ( SSL_cipher_list => defined $arg->{'ciphers'} ? $arg->{'ciphers'} : 'ALL', SSL_ca_file => exists $arg->{'cafile'} ? $arg->{'cafile'} : '', SSL_ca_path => exists $arg->{'capath'} ? $arg->{'capath'} : '', SSL_key_file => $clientcert ? $clientkey : undef, + SSL_passwd_cb => $passwdcb, SSL_use_cert => $clientcert ? 1 : 0, SSL_cert_file => $clientcert, SSL_verify_mode => $verify, @@ -131,12 +136,26 @@ =item clientkey +=item decryptkey + If you want to use the client to offer a certificate to the server for SSL authentication (which is not the same as for the LDAP Bind operation) then set clientcert to the user's certificate file, and clientkey to the user's private key file. These files must be in PEM format. +If the private key is encrypted (highly recommended!) then set +decryptkey to a reference to a subroutine that returns the decrypting +key. For example: + + $ldaps = new Net::LDAPS('myhost.example.com', + port => '636', + verify => 'require', + clientcert => 'mycert.pem', + clientkey => 'mykey.pem', + decryptkey => sub { 'secret'; }, + capath => '/usr/local/cacerts/'); + =item capath =item cafile @@ -147,8 +166,8 @@ server's certificate. These certificates must all be in PEM format. The directory in 'capath' must contain certificates named using the -hash value of themselves. To generate these names, use OpenSSL like -this in Unix: +hash value of the certificates' subject names. To generate these +names, use OpenSSL like this in Unix: ln -s cacert.pem `openssl x509 -hash -noout < cacert.pem`.0 @@ -188,22 +207,8 @@ =head1 BUGS -Several apparently bogus warnings are emitted when initializing the -two underlying modules used by Net::LDAPS, namely IO::Socket::SSL and -Net::SSLeay. To avoid these, don't initialize via 'use Net::LDAPS' and -instead try initializing Net::LDAPS like this: - - BEGIN { - # Turn off all warnings etc whilst initializing - # IO::Socket::SSL and Net::SSLeay. - local $^W = 0; - no strict; - require Net::SSLeay; - # The /dev/urandom is a device on Linux that returns - # random data. - Net::SSLeay::randomize('/dev/urandom'); - require Net::LDAPS; - } +You cannot have more than one LDAPS connection at any one time, due to +restrictions in the underlying Net::SSLeay code. =head1 AUTHOR @@ -211,7 +216,7 @@ =head1 COPYRIGHT -Copyright (c) 2000-2001, Chris Ridd and Graham Barr. All rights reserved. This +Copyright (c) 2000-2002, Chris Ridd and Graham Barr. All rights reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. |
From: Graham B. <gb...@us...> - 2002-05-28 10:08:32
|
Update of /cvsroot/perl-ldap/ldap/lib/Net/LDAP/DSML In directory usw-pr-cvs1:/tmp/cvs-serv4795/lib/Net/LDAP/DSML Removed Files: Parser.pm Log Message: New DSML module that uses XML::SAX --- Parser.pm DELETED --- |
From: Graham B. <gb...@us...> - 2002-05-28 10:08:30
|
Update of /cvsroot/perl-ldap/ldap In directory usw-pr-cvs1:/tmp/cvs-serv24364 Removed Files: mkhtml mkindex Log Message: No longer including html generated from POD in the distribution --- mkhtml DELETED --- --- mkindex DELETED --- |
From: Graham B. <gb...@us...> - 2002-05-28 10:08:25
|
Update of /cvsroot/perl-ldap/ldap/lib/Net/LDAP In directory usw-pr-cvs1:/tmp/cvs-serv11631/lib/Net/LDAP Modified Files: Schema.pm Log Message: Fix bug when fetching elements with OIDs Index: Schema.pm =================================================================== RCS file: /cvsroot/perl-ldap/ldap/lib/Net/LDAP/Schema.pm,v retrieving revision 1.14 retrieving revision 1.15 diff -u -d -r1.14 -r1.15 --- Schema.pm 23 Apr 2002 10:57:29 -0000 1.14 +++ Schema.pm 28 May 2002 07:57:45 -0000 1.15 @@ -7,7 +7,7 @@ use strict; use vars qw($VERSION); -$VERSION = "0.99"; +$VERSION = "0.9901"; # # Get schema from the server (or read from LDIF) and parse it into @@ -174,11 +174,12 @@ sub _get { my $self = shift; - my $type = $self->{ pop(@_) }; + my $type = pop(@_); + my $hash = $self->{$type}; my $oid = $self->{oid}; my @elem = grep $_, map { - my $elem = $type->{lc $_}; + my $elem = $hash->{lc $_}; ($elem or ($elem = $oid->{$_} and $elem->{type} eq $type)) ? $elem |
From: Graham B. <gb...@us...> - 2002-05-28 10:08:25
|
Update of /cvsroot/perl-ldap/ldap/lib/Net In directory usw-pr-cvs1:/tmp/cvs-serv25909/lib/Net Modified Files: LDAP.pm Log Message: Remember host connected to, needed for sasl Index: LDAP.pm =================================================================== RCS file: /cvsroot/perl-ldap/ldap/lib/Net/LDAP.pm,v retrieving revision 1.32 retrieving revision 1.33 diff -u -d -r1.32 -r1.33 --- LDAP.pm 21 May 2002 14:53:58 -0000 1.32 +++ LDAP.pm 28 May 2002 09:34:50 -0000 1.33 @@ -22,7 +22,7 @@ LDAP_INAPPROPRIATE_AUTH ); -$VERSION = "0.25_01"; +$VERSION = "0.25_50"; @ISA = qw(Net::LDAP::Extra); $LDAP_VERSION = 2; # default LDAP protocol version @@ -105,6 +105,7 @@ return undef unless $obj->{net_ldap_socket}; + $obj->{net_ldap_host} = $host; $obj->{net_ldap_resp} = {}; $obj->{net_ldap_version} = $arg->{version} || $LDAP_VERSION; $obj->{net_ldap_async} = $arg->{async} ? 1 : 0; |
From: Graham B. <gb...@us...> - 2002-05-28 10:08:24
|
Update of /cvsroot/perl-ldap/ldap In directory usw-pr-cvs1:/tmp/cvs-serv23408 Modified Files: CREDITS Log Message: Add Kartik Subbarao and Norbert Klasen Index: CREDITS =================================================================== RCS file: /cvsroot/perl-ldap/ldap/CREDITS,v retrieving revision 1.1 retrieving revision 1.2 diff -u -d -r1.1 -r1.2 --- CREDITS 30 Jul 2000 21:03:50 -0000 1.1 +++ CREDITS 28 May 2002 09:03:30 -0000 1.2 @@ -27,4 +27,5 @@ Jim Harle <ha...@us...> Kurt D. Zeilenga <Ku...@Op...> Simon Wilcox <Sim...@wi...> - +Kartik Subbarao <sub...@co...> +Norbert Klasen <nor...@da...> |
From: Graham B. <gb...@us...> - 2002-05-28 10:08:18
|
Update of /cvsroot/perl-ldap/ldap/htdocs In directory usw-pr-cvs1:/tmp/cvs-serv24364/htdocs Removed Files: index.xml Log Message: No longer including html generated from POD in the distribution --- index.xml DELETED --- |
From: Graham B. <gb...@us...> - 2002-05-28 10:08:15
|
Update of /cvsroot/perl-ldap/ldap/lib/Net/LDAP In directory usw-pr-cvs1:/tmp/cvs-serv4795/lib/Net/LDAP Modified Files: DSML.pm Log Message: New DSML module that uses XML::SAX Index: DSML.pm =================================================================== RCS file: /cvsroot/perl-ldap/ldap/lib/Net/LDAP/DSML.pm,v retrieving revision 1.12 retrieving revision 1.13 diff -u -d -r1.12 -r1.13 --- DSML.pm 3 Jan 2002 03:01:14 -0000 1.12 +++ DSML.pm 28 May 2002 07:52:25 -0000 1.13 @@ -1,783 +1,672 @@ -package Net::LDAP::DSML; - -# -# $Id$ -# -# For schema parsing, add ability to Net::LDAP::Schema to accecpt -# a Net::LDAP::Entry object. First -# we'll convert XML into Net::LDAP::Entry with schema attributes and -# then pass to schema object constructor -# [...1316 lines suppressed...] -=head1 COPYRIGHT +use vars qw($AUTOLOAD); -Copyright (c) 2000 Graham Barr and Mark Wilcox. All rights reserved. This program is -free software; you can redistribute it and/or modify it under the same -terms as Perl itself. +sub DESTROY {} -=cut +sub AUTOLOAD { + (my $meth = $AUTOLOAD) =~ s/^.*:://; + require XML::SAX::Writer; + my $self = shift; + $self->{handler} = XML::SAX::Writer->new; + bless $self, 'Net::LDAP::DSML::pp'; + $self->$meth(@_); +} +1; |
From: Graham B. <gb...@us...> - 2002-05-28 10:08:14
|
Update of /cvsroot/perl-ldap/ldap/lib/Net/LDAP In directory usw-pr-cvs1:/tmp/cvs-serv31656/lib/Net/LDAP Modified Files: Entry.pm Log Message: Fix return hash for get_value($attr, alloptions => 1); Index: Entry.pm =================================================================== RCS file: /cvsroot/perl-ldap/ldap/lib/Net/LDAP/Entry.pm,v retrieving revision 1.9 retrieving revision 1.10 diff -u -d -r1.9 -r1.10 --- Entry.pm 10 Nov 2001 06:35:12 -0000 1.9 +++ Entry.pm 28 May 2002 08:13:32 -0000 1.10 @@ -9,7 +9,7 @@ use Net::LDAP::Constant qw(LDAP_LOCAL_ERROR); use vars qw($VERSION); -$VERSION = "0.16"; +$VERSION = "0.17"; sub new { my $self = shift; @@ -78,7 +78,7 @@ if ($opt{alloptions}) { my %ret = map { - $_->{type} =~ /^\Q$type\E(.*)/i ? (lc($1), $_->{vals}) : () + $_->{type} =~ /^\Q$type\E((?:;.*)?)$/i ? (lc($1), $_->{vals}) : () } @{$self->{asn}{attributes}}; return %ret ? \%ret : undef; } |
From: Clif H. <ch...@us...> - 2002-05-28 01:54:17
|
Update of /cvsroot/perl-ldap/ldap/contrib In directory usw-pr-cvs1:/tmp/cvs-serv21271/ldap/contrib Modified Files: tklkup Log Message: Made several code corrections to the code that stores xml formatted schema information in a file. This is due to the new DSML.pm module. Index: tklkup =================================================================== RCS file: /cvsroot/perl-ldap/ldap/contrib/tklkup,v retrieving revision 1.25 retrieving revision 1.26 diff -u -d -r1.25 -r1.26 --- tklkup 25 May 2002 05:05:55 -0000 1.25 +++ tklkup 28 May 2002 01:54:13 -0000 1.26 @@ -22,6 +22,11 @@ # # Revisions: # $Log$ +# Revision 1.26 2002/05/28 01:54:13 charden +# +# Made several code corrections to the code that stores xml formatted +# schema information in a file. This is due to the new DSML.pm module. +# # Revision 1.25 2002/05/25 05:05:55 charden # # Change schema code to comprehend the new Schema.pm file. @@ -190,6 +195,7 @@ # use Carp; +use Data::Dumper; use MIME::Base64; use Net::LDAP qw(:all); use Net::LDAP::Filter; @@ -1668,19 +1674,19 @@ # # write XML text to file instead of text box # - $dsml = Net::LDAP::DSML->new(); - open(FXML, ">$Global{'fdata'}"); - $dsml->open(*FXML); - $dsml->write($schemaHash{'schema'}); - $dsml->finish(); - close(FXML); +# @xml_data = (); +# $dsml = Net::LDAP::DSML->new( output => \@xml_data, pretty_print => 1 ); + open(FXML, ">$Global{'fdata'}"); + $dsml = Net::LDAP::DSML->new( output => *FXML, pretty_print => 1 ); + $dsml->write_schema($schemaHash{'schema'}); + close(FXML); } else { - # - # write straight text to file instead of text box - # - $schemaHash{'schema'}->dump( $Global{'fdata'} ); + # + # write straight text to file instead of text box + # + $schemaHash{'schema'}->dump( $Global{'fdata'} ); } $schema_list->insert("end", @@ -2089,8 +2095,7 @@ # Get the various other items associated with # this objectclass. # - my $ahash = $schema->objectclass( "$var" ); - + my $ahash = $schema->objectclass( "$oid" ); my @hkeys = sort(keys(%$ahash)); # # Get and display the objectclass name. |
From: Clif H. <ch...@us...> - 2002-05-25 05:05:58
|
Update of /cvsroot/perl-ldap/ldap/contrib In directory usw-pr-cvs1:/tmp/cvs-serv17902/ldap/contrib Modified Files: tklkup Log Message: Change schema code to comprehend the new Schema.pm file. Added code to determine new x and y position when the main window moves. Index: tklkup =================================================================== RCS file: /cvsroot/perl-ldap/ldap/contrib/tklkup,v retrieving revision 1.24 retrieving revision 1.25 diff -u -d -r1.24 -r1.25 --- tklkup 3 Jan 2002 02:53:53 -0000 1.24 +++ tklkup 25 May 2002 05:05:55 -0000 1.25 @@ -22,6 +22,11 @@ # # Revisions: # $Log$ +# Revision 1.25 2002/05/25 05:05:55 charden +# +# Change schema code to comprehend the new Schema.pm file. +# Added code to determine new x and y position when the main window moves. +# # Revision 1.24 2002/01/03 02:53:53 charden # # Corrected schema parse and display code to comprehend that a multi-valued @@ -209,6 +214,9 @@ eval { use Tk::JPEG; }; $Global{'jpeg'} = 0 if ( $@ ); +# +# Window roots +# $Global{'mainWindow'} = undef(); $Global{'schemaWindow'} = undef(); $Global{'histWindow'} = undef(); @@ -1055,6 +1063,8 @@ $dn_data = ""; $pw_data = ""; +&globalPos(); + my $x = $Global{'horz'} + 150; my $y = $Global{'vert'} + 150; @@ -1195,6 +1205,7 @@ sub PORT { $port_data = $Global{'port'}; +&globalPos(); my $x = $Global{'horz'} + 150; my $y = $Global{'vert'} + 150; @@ -1263,46 +1274,76 @@ my $list = shift; my $ocs = shift; my $Title = shift; -my $method = shift; +#my $method = shift; -foreach ( @$ocs) +my $asize; +my $ahash; +my $var; + +foreach $ahash ( @$ocs) { $list->insert("end", "$Title\n"); # - # Get and display the oid number of the objectclass. + # Get and display the data for this object # - my $oid = $schemaHash{'schema'}->$method( "$_" ); -# my $oid = $schemaHash{'schema'}->name2oid( "$_" ); - + + my @hkeys = keys(%$ahash); + + foreach $var (@hkeys) + { + # Step thru the hash keys + + next if ( $var =~ /type/); # do not care about type + + $alArray = $$ahash{$var}; + + if ( ref($alArray) eq 'ARRAY' ) + { + # it is a n array pointer so there is probably a list. + + my $asize = @$alArray; # get the size of the list. # - # Get the various other items associated with - # this attribute. + # if the array has size then print the array + # else ignore the array. # - my @items = $schemaHash{'schema'}->items( "$oid" ); - foreach my $value ( @items ) + if ( $asize ) { - next if ( $value eq 'type'); + # Okay, there is something in the array. - @item = $schemaHash{'schema'}->item( $oid, $value ); - $value =~ tr/a-z/A-Z/; - if ( @item && $item[0] eq '1' ) - { - $list->insert("end", "\t$value\n"); - next; - } - if ( defined(@item) ) - { - if ( $value eq 'MAY' || $value eq 'MUST' ) - { - $list->insert("end", "\t$value contain: @item\n"); - } - else - { - $list->insert("end", "\t$value: @item\n"); - } - } + $list->insert("end", "\t$var: "); + + foreach $a ( @$alArray ) + { + $list->insert("end", "$a "); + } + $list->insert("end", "\n"); + } + } + else + { + # There is not an array + if ( $alArray == 1) + { + # it is just information attribute for the object + $list->insert("end", "\t$var\n"); } + else + { + $list->insert("end", "\t$var: $alArray\n"); + } + } + +} + + + # + # Get the various other items associated with + # this attribute. + # +# next if ( $value eq 'type'); + +# $value =~ tr/a-z/A-Z/; } @@ -1328,6 +1369,7 @@ my $tframe; my $sbframe; #my $sslist; +&globalPos(); my $x = $Global{'horz'} + 100; my $y = $Global{'vert'} + 100; # @@ -1655,7 +1697,7 @@ # # Get the attributes # -@$ra_atts = $schemaHash{'schema'}->attributes(); +@$ra_atts = $schemaHash{'schema'}->all_attributes(); $schemaHash{'atts'} = $ra_atts; @@ -1665,7 +1707,7 @@ if ( $selectAll || $selectAtt ) { -&print_loop($schema_list, $schemaHash{'atts'}, "attributeType", "is_attribute") +&print_loop($schema_list, $schemaHash{'atts'}, "attributeType") if ( defined($schemaHash{'atts'}) ); } @@ -1673,14 +1715,18 @@ # # Get the schema objectclasses # -@$ra_atts = $schemaHash{'schema'}->objectclasses(); +@$ra_atts = $schemaHash{'schema'}->all_objectclasses(); $schemaHash{'ocs'} = $ra_atts; # # Calculate the text length of each objectclass string. # -foreach (@$ra_atts) { $Global{'max'} = length($_) - if length($_) > $Global{'max'} } +foreach my $var (@$ra_atts) +{ +$Global{'max'} = length($$var{'name'}) + if length($$var{'name'}) > $Global{'max'} + +} # # Add 6 to the max objectclass string size, @@ -1695,7 +1741,7 @@ if ( $selectAll || $selectObj ) { -&print_loop($schema_list, $schemaHash{'ocs'}, "objectClasses", "is_objectclass") +&print_loop($schema_list, $schemaHash{'ocs'}, "objectClasses") if ( defined($schemaHash{'ocs'}) ); } @@ -1704,7 +1750,7 @@ # Get the schema matchingrules # $ra_atts = []; -@$ra_atts = $schemaHash{'schema'}->matchingrules(); +@$ra_atts = $schemaHash{'schema'}->all_matchingrules(); $schemaHash{'mrs'} = $ra_atts; # @@ -1713,7 +1759,7 @@ if ( $selectAll || $selectMatch ) { -&print_loop($schema_list, $schemaHash{'mrs'}, "matchingRules", "is_matchingrule" ) +&print_loop($schema_list, $schemaHash{'mrs'}, "matchingRules" ) if ( defined($schemaHash{'mrs'}) ); } @@ -1721,7 +1767,7 @@ # Get the schema matchingruleuse # $ra_atts = []; -@$ra_atts = $schemaHash{'schema'}->matchingruleuse(); +@$ra_atts = $schemaHash{'schema'}->all_matchingruleuses(); $schemaHash{'mru'} = $ra_atts; # @@ -1730,7 +1776,7 @@ if ( $selectAll || $selectMru ) { -&print_loop($schema_list, $schemaHash{'mru'}, "matchingRuleUse", "is_matchinruleuse" ) +&print_loop($schema_list, $schemaHash{'mru'}, "matchingRuleUse" ) if ( defined($schemaHash{'mru'}) ); } @@ -1738,7 +1784,7 @@ # Get the schema ldapsyntaxes # $ra_atts = []; -@$ra_atts = $schemaHash{'schema'}->syntaxes(); +@$ra_atts = $schemaHash{'schema'}->all_syntaxes(); $schemaHash{'lsyn'} = $ra_atts; # @@ -1747,7 +1793,7 @@ if ( $selectAll || $selectSyn ) { -&print_loop($schema_list, $schemaHash{'lsyn'}, "ldapSyntax", "is_syntax" ) +&print_loop($schema_list, $schemaHash{'lsyn'}, "ldapSyntax" ) if ( defined($schemaHash{'lsyn'}) ); } @@ -1755,7 +1801,7 @@ # Get the schema nameForms # $ra_atts = []; -@$ra_atts = $schemaHash{'schema'}->nameforms(); +@$ra_atts = $schemaHash{'schema'}->all_nameforms(); $schemaHash{'nfm'} = $ra_atts; # @@ -1764,7 +1810,7 @@ if ( $selectAll || $selectNf ) { -&print_loop($schema_list, $schemaHash{'nfm'}, "nameForms", "is_nameform" ) +&print_loop($schema_list, $schemaHash{'nfm'}, "nameForms" ) if ( defined($schemaHash{'nfm'}) ); } @@ -1772,7 +1818,7 @@ # Get the schema ditstructurerules # $ra_atts = []; -@$ra_atts = $schemaHash{'schema'}->ditstructurerules(); +@$ra_atts = $schemaHash{'schema'}->all_ditstructurerules(); $schemaHash{'dits'} = $ra_atts; # @@ -1781,7 +1827,7 @@ if ( $selectAll || $selectDsr ) { -&print_loop($schema_list, $schemaHash{'dits'}, "ditstructurerules", "is_ditstructurerule" ) +&print_loop($schema_list, $schemaHash{'dits'}, "ditstructurerules" ) if ( defined($schemaHash{'dits'}) ); } @@ -1789,7 +1835,7 @@ # Get the schema ditcontentrules # $ra_atts = []; -@$ra_atts = $schemaHash{'schema'}->ditcontentrules(); +@$ra_atts = $schemaHash{'schema'}->all_ditcontentrules(); $schemaHash{'ditc'} = $ra_atts; # @@ -1798,7 +1844,7 @@ if ( $selectAll || $selectDcr ) { -&print_loop($schema_list, $schemaHash{'ditc'}, "ditcontentrules", "is_ditcontentrule" ) +&print_loop($schema_list, $schemaHash{'ditc'}, "ditcontentrules" ) if ( defined($schemaHash{'ditc'}) ); } @@ -1847,6 +1893,7 @@ sub Hierarchial { +&globalPos(); my $x = $Global{'horz'}; my $y = $Global{'vert'} + 200 ; my $ocs = $schemaHash{'ocs'}; @@ -1878,24 +1925,31 @@ # # Get the schema objectClasses # -foreach ( @$ocs) +foreach my $aobj ( @$ocs) { # # Get the oid number of the objectclass. # my $oid; undef($oid); - - $oid = $schema->name2oid( "$_" ); +# print "$aobj\n"; + $oid = $$aobj{'oid'}; next if ( !defined($oid) ); - - @sup = $schema->item( $oid, 'sup' ); # objectclass superior - @name = $schema->item( $oid, 'name' ); # objectclass name +# print "oid; $oid\n"; +# print "sup ",$$aobj{'sup'},"\n"; +# print "name ",$$aobj{'name'},"\n"; + @sup = $$aobj{'sup'}[0]; + @name = $$aobj{'name'}; +# print "sup : @sup\n"; +# @sup = $schema->item( $oid, 'sup' ); # objectclass superior +# @name = $schema->item( $oid, 'name' ); # objectclass name $$obj{"$name[0]"} = [ "$oid", "$sup[0]" ]; # store data } +#return; + # # get objectclass hash keys. # @@ -2030,36 +2084,66 @@ foreach my $var (@objectclasses) { - $oid = $$obj{$var}->[0]; - + $oid = $$obj{$var}->[0]; # # Get the various other items associated with - # this attribute. + # this objectclass. # - my @items = $schema->items( "$oid" ); - foreach my $value ( @items ) + my $ahash = $schema->objectclass( "$var" ); + + my @hkeys = sort(keys(%$ahash)); + # + # Get and display the objectclass name. + # + $alArray = $$ahash{'name'}; + $Global{'list'}->insert("end", "name: $alArray\n"); + + foreach $varr (@hkeys) { - next if ( $value eq 'type'); + # Step thru the hash keys + + next if ( $varr =~ /name/); # already done name. + next if ( $varr =~ /type/); # do not care about type - @item = $schema->item( $oid, $value ); - $value =~ tr/a-z/A-Z/; - if ( @item && $item[0] eq '1' ) - { - $Global{'list'}->insert("end", "$value\n"); - next; - } - if ( defined(@item) ) + $alArray = $$ahash{$varr}; + + if ( ref($alArray) eq 'ARRAY' ) + { + # it is a n array pointer so there is probably a list. + + my $asize = @$alArray; # get the size of the list. + # + # if the array has size then print the array + # else ignore the array. + # + if ( $asize ) + { + # Okay, there is something in the array. + + $Global{'list'}->insert("end", "\t$varr: "); + + foreach $a ( @$alArray ) { - if ( $value eq 'MAY' || $value eq 'MUST' ) - { - $Global{'list'}->insert("end", "$value contain: @item\n"); - } - else - { - $Global{'list'}->insert("end", "$value: @item\n"); - } + $Global{'list'}->insert("end", "$a "); } - } + $Global{'list'}->insert("end", "\n"); + } + } + else + { + # It is not an array + if ( $alArray == 1) + { + # it is just and information attribute for the object + $Global{'list'}->insert("end", "\t$varr\n"); + } + else + { + $Global{'list'}->insert("end", "\t$varr: $alArray\n"); + } + } + + } $Global{'list'}->insert("end", " \n"); $Global{'list'}->insert("end", "--------------------------------------------------\n"); @@ -2141,6 +2225,7 @@ # sub questionAction { +&globalPos(); my $x = $Global{'horz'} + 0; my $y = $Global{'vert'} + 50; @@ -2180,7 +2265,7 @@ &ldapActionDelete; } # End of accept subroutine -} # End of BIND subroutine +} # End of questionAction subroutine # @@ -2190,7 +2275,8 @@ sub ldapAction { $Global{'ldapActionDN'} = shift; - + +&globalPos(); my $x = $Global{'horz'} + 0; my $y = $Global{'vert'} + 30; @@ -2515,6 +2601,7 @@ # if (!Exists($Global{'changeWindow'}) ) { +&globalPos(); my $x = $Global{'horz'} + 75; my $y = $Global{'vert'} + 75; my $acframe; @@ -2897,6 +2984,8 @@ ERROR($errstr); } +$ldap->unbind; + } # @@ -2975,6 +3064,7 @@ $Global{'newrdn'} = ""; $Global{'RenameDN'} = ""; $Global{'deleteoldrdn'} = 1; +&globalPos(); my $x = $Global{'horz'} + 0; my $y = $Global{'vert'} + 50; my @rdnData; @@ -3110,6 +3200,7 @@ my $lframe; my $rbclear; #my $list; +&globalPos(); my $x = $Global{'horz'} + 100; my $y = $Global{'vert'} + 100; # @@ -3218,6 +3309,7 @@ my $ecframe; my $elframe; my $erbclear; +&globalPos(); my $x = $Global{'horz'} + 75; my $y = $Global{'vert'} + 75; # @@ -3456,6 +3548,7 @@ sub displayDnList { +&globalPos(); my $x = $Global{'horz'}; my $y = $Global{'vert'} + 230 ; @@ -4017,6 +4110,7 @@ sub rootDse { my $base; +&globalPos(); my $x = $Global{'horz'} + 150; my $y = $Global{'vert'} + 150; my $error; @@ -4114,6 +4208,19 @@ } $ldap->unbind; + +} + +# +# Determine new mainWindow position. +# +sub globalPos +{ + +my @pos; +@pos = split(/\+/,$Global{'mainWindow'}->geometry()); +$Global{'horz'} = $pos[1]; +$Global{'vert'} = $pos[2]; } |
From: Chris R. <chr...@us...> - 2002-05-21 14:54:03
|
Update of /cvsroot/perl-ldap/ldap/lib/Net In directory usw-pr-cvs1:/tmp/cvs-serv12443 Modified Files: LDAP.pm Log Message: Changed extendedRequest to extendedReq Index: LDAP.pm =================================================================== RCS file: /cvsroot/perl-ldap/ldap/lib/Net/LDAP.pm,v retrieving revision 1.31 retrieving revision 1.32 diff -u -d -r1.31 -r1.32 --- LDAP.pm 17 May 2002 13:49:48 -0000 1.31 +++ LDAP.pm 21 May 2002 14:53:58 -0000 1.32 @@ -583,7 +583,7 @@ if $ldap->{net_ldap_version} < 3; $mesg->encode( - extendedRequest => { + extendedReq => { requestName => $arg->{name}, requestValue => $arg->{value} }, |
From: Chris R. <chr...@us...> - 2002-05-17 13:50:58
|
Update of /cvsroot/perl-ldap/ldap In directory usw-pr-cvs1:/tmp/cvs-serv16627 Modified Files: Makefile.PL Log Message: Specified minimum version of IO::Socket::SSL Index: Makefile.PL =================================================================== RCS file: /cvsroot/perl-ldap/ldap/Makefile.PL,v retrieving revision 1.8 retrieving revision 1.9 diff -u -d -r1.8 -r1.9 --- Makefile.PL 18 Feb 2002 16:51:41 -0000 1.8 +++ Makefile.PL 17 May 2002 13:50:56 -0000 1.9 @@ -59,7 +59,7 @@ The Digest::MD5 module is needed ONLY IF intend to use CRAM-MD5 SASL authentication EDQ -check_module('IO::Socket::SSL') or print <<"EDQ","\n"; +check_module('IO::Socket::SSL',0.81) or print <<"EDQ","\n"; The IO::Socket::SSL module is needed ONLY IF you intend to use LDAPS EDQ |