Menu
▾
▴
perl-ldap-checkins — CVS checkin diffs
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: Chris R. <chr...@us...> - 2002-05-17 13:49:52
|
Update of /cvsroot/perl-ldap/ldap/lib/Net
In directory usw-pr-cvs1:/tmp/cvs-serv16129
Modified Files:
LDAP.pm
Log Message:
Removed workaround for old IO::Socket::SSL versions
Index: LDAP.pm
===================================================================
RCS file: /cvsroot/perl-ldap/ldap/lib/Net/LDAP.pm,v
retrieving revision 1.30
retrieving revision 1.31
diff -u -d -r1.30 -r1.31
--- LDAP.pm 18 Feb 2002 16:51:42 -0000 1.30
+++ LDAP.pm 17 May 2002 13:49:48 -0000 1.31
@@ -807,7 +807,7 @@
require Net::LDAPS;
$arg->{sslversion} = 'tlsv1' unless defined $arg->{sslversion};
IO::Socket::SSL::context_init( { Net::LDAPS::SSL_context_init_args($arg) } );
- (IO::Socket::SSL::socketToSSL($sock) and tie *{$sock}, 'IO::Socket::SSL', $sock)
+ IO::Socket::SSL::socketToSSL($sock)
? $mesg
: _error($ldap, $mesg, LDAP_OPERATIONS_ERROR, $@);
}
|
|
From: Graham B. <gb...@us...> - 2002-04-23 16:08:01
|
Update of /cvsroot/perl-ldap/ldap/lib/LWP/Protocol
In directory usw-pr-cvs1:/tmp/cvs-serv14900/LWP/Protocol
Modified Files:
ldap.pm
Log Message:
Patch from ma...@ev...
Index: ldap.pm
===================================================================
RCS file: /cvsroot/perl-ldap/ldap/lib/LWP/Protocol/ldap.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- ldap.pm 16 Aug 2000 11:07:33 -0000 1.2
+++ ldap.pm 23 Apr 2002 16:07:57 -0000 1.3
@@ -1,4 +1,4 @@
-# Copyright (c) 1998 Graham Barr <gb...@po...>. All rights reserved.
+# Copyright (c) 1998-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.
@@ -13,6 +13,8 @@
require LWP::Protocol;
@ISA = qw(LWP::Protocol);
+$VERSION = "1.10";
+
use strict;
eval {
require Net::LDAP;
@@ -56,8 +58,7 @@
my $host = $url->host;
my $port = $url->port;
- my $user = $url->user;
- my $password = $url->password;
+ my ($user, $password) = split(":", $url->userinfo, 2);
# Create an initial response object
my $response = new HTTP::Response &HTTP::Status::RC_OK, "Document follows";
@@ -65,7 +66,7 @@
my $ldap = new Net::LDAP($host, port => $port);
- my $mesg = $ldap->bind;
+ my $mesg = $ldap->bind($user, password => $password);
if ($mesg->code) {
my $res = new HTTP::Response &HTTP::Status::RC_BAD_REQUEST,
@@ -94,42 +95,41 @@
return $res;
}
else {
- my $content = "<HEAD><TITLE>Directory Search Results</TITLE></HEAD>\n<BODY>";
+ my $content = "<head><title>Directory Search Results</title></head>\n<body>";
my $entry;
my $index;
for($index = 0 ; $entry = $mesg->entry($index) ; $index++ ) {
my $attr;
- $content .= $index ? "<TR><TH COLSPAN=2><hr> </TR>\n"
- : "<TABLE>";
+ $content .= $index ? qq{<tr><th colspan="2"><hr> </tr>\n} : "<table>";
- $content .= "<TR><TH COLSPAN=2>" . $entry->dn . "</TH></TR>\n";
+ $content .= qq{<tr><th colspan="2">} . $entry->dn . "</th></tr>\n";
foreach $attr ($entry->attributes) {
my $vals = $entry->get_value($attr, asref => 1);
my $val;
- $content .= "<TR><TD align=right valign=top";
- $content .= " ROWSPAN=" . scalar(@$vals)
+ $content .= q{<tr><td align="right" valign="top"};
+ $content .= q{ rowspan="} . scalar(@$vals) . q{"}
if (@$vals > 1);
- $content .= ">" . $attr . " </TD>\n";
+ $content .= ">" . $attr . " </td>\n";
my $j = 0;
foreach $val (@$vals) {
$val = qq!<a href="$val">$val</a>! if $val =~ /^https?:/;
$val = qq!<a href="mailto:$val">$val</a>! if $val =~ /^[-\w]+\@[-.\w]+$/;
- $content .= "<TR>" if $j++;
- $content .= "<TD>" . $val . "</TD></TR>\n";
+ $content .= "<tr>" if $j++;
+ $content .= "<td>" . $val . "</td></tr>\n";
}
}
}
- $content .= "</TABLE>" if $index;
+ $content .= "</table>" if $index;
$content .= "<hr>";
$content .= $index ? sprintf("%s Match%s found",$index, $index>1 ? "es" : "")
- : "<B>No Matches found</B>";
- $content .= "</BODY>\n";
+ : "<b>No Matches found</b>";
+ $content .= "</body>\n";
$response->header('Content-Type' => 'text/html');
$response->header('Content-Length', length($content));
$response = $self->collect_once($arg, $response, $content)
@@ -141,3 +141,5 @@
$response;
}
+
+1;
|
|
From: Graham B. <gb...@us...> - 2002-04-23 10:57:33
|
Update of /cvsroot/perl-ldap/ldap/lib/Net/LDAP
In directory usw-pr-cvs1:/tmp/cvs-serv1015/lib/Net/LDAP
Modified Files:
Schema.pm Schema.pod
Log Message:
New Schema API
Index: Schema.pm
===================================================================
RCS file: /cvsroot/perl-ldap/ldap/lib/Net/LDAP/Schema.pm,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -d -r1.13 -r1.14
--- Schema.pm 23 Jan 2002 13:25:30 -0000 1.13
+++ Schema.pm 23 Apr 2002 10:57:29 -0000 1.14
@@ -1,4 +1,4 @@
-# Copyright (c) 1998-2000 Graham Barr <gb...@po...>. All rights reserved.
+# Copyright (c) 1998-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.
@@ -7,10 +7,10 @@
use strict;
use vars qw($VERSION);
-$VERSION = "0.12";
+$VERSION = "0.99";
#
-# Get schema from the server (or read from LDIF) and parse it into
+# Get schema from the server (or read from LDIF) and parse it into
# data structure
#
sub new {
@@ -37,7 +37,7 @@
$schema->{error} = "Bad argument";
return undef;
}
-
+
%$schema = ();
my $entry;
@@ -69,7 +69,7 @@
$schema->{error} = "Can't load schema from [$arg]: $!";
return undef;
}
-
+
eval {
local $SIG{__DIE__} = sub {};
_parse_schema( $schema, $entry );
@@ -109,271 +109,93 @@
# parameters describing what to do in the event of a clash.
}
-#
-# The names of all the attributes.
-# Or all atts in (one or more) objectclass(es).
-#
-sub attributes {
- my $self = shift;
- my @oc = @_;
- my %res;
-
- if( @oc ) {
- @res{ $self->must( @oc ) } = ();
- @res{ $self->may( @oc ) } = ();
- }
- else {
- @res{ @{ $self->{at} } } = () if $self->{at};
- }
-
- return wantarray ? (keys %res) : [keys %res];
-}
-
-# The names of all the object classes
-
-sub objectclasses {
- my $self = shift;
- my $res = $self->{oc};
- return wantarray ? @$res : $res;
-}
-
-# Return all syntaxes
-
-sub syntaxes {
- my $self = shift;
- my $res = $self->{syn};
- return wantarray ? @$res : $res;
-}
-
-# The names of all the matchingrules
-
-sub matchingrules {
- my $self = shift;
- my $res = $self->{mr};
- return wantarray ? @$res : $res;
-}
-
-# The names of all the matchingruleuse
-
-sub matchingruleuse {
- my $self = shift;
- my $res = $self->{mru};
- return wantarray ? @$res : $res;
-}
-
-# The names of all the ditstructurerules
-
-sub ditstructurerules {
- my $self = shift;
- my $res = $self->{dts};
- return wantarray ? @$res : $res;
-}
-
-# The names of all the ditcontentrules
-
-sub ditcontentrules {
- my $self = shift;
- my $res = $self->{dtc};
- return wantarray ? @$res : $res;
-}
-
-# The names of all the nameforms
-
-sub nameforms {
- my $self = shift;
- my $res = $self->{nfm};
- return wantarray ? @$res : $res;
-}
+sub all_attributes { values %{shift->{at}} }
+sub all_objectclasses { values %{shift->{oc}} }
+sub all_syntaxes { values %{shift->{syn}} }
+sub all_matchingrules { values %{shift->{mr}} }
+sub all_matchingruleuses { values %{shift->{mru}} }
+sub all_ditstructurerules { values %{shift->{dts}} }
+sub all_ditcontentrules { values %{shift->{dtc}} }
+sub all_nameforms { values %{shift->{nfm}} }
sub superclass {
- my $self = shift;
- my $oc = shift;
-
- my $oid = $self->is_objectclass( $oc );
- return scalar _error($self, "Not an objectClass") unless $oid;
+ my $self = shift;
+ my $oc = shift;
- my $res = $self->{oid}->{$oid}->{sup};
- return scalar _error($self, "No superclass") unless $res;
- return wantarray ? @$res : $res;
-}
+ my $elem = $self->objectclass( $oc )
+ or return scalar _error($self, "Not an objectClass");
-sub must {
- my $self = shift;
- $self->_must_or_may( "must", @_ );
+ return @{$elem->{sup} || []};
}
-sub may {
- my $self = shift;
- $self->_must_or_may( "may", @_ );
-}
+sub must { _must_or_may(@_,'must') }
+sub may { _must_or_may(@_,'may') }
#
-# Return must or may attributes for this OC. [As array or array ref]
-# return empty array/undef on error
+# Return must or may attributes for this OC.
#
sub _must_or_may {
my $self = shift;
- my $must_or_may = shift;
+ my $must_or_may = pop;
my @oc = @_ or return;
-
+
#
# If called with an entry, get the OC names and continue
#
- if( UNIVERSAL::isa( $oc[0], "Net::LDAP::Entry" ) ) {
+ if ( UNIVERSAL::isa( $oc[0], "Net::LDAP::Entry" ) ) {
my $entry = $oc[0];
@oc = $entry->get_value( "objectclass" )
or return;
}
- my %res; # Use hash to get uniqueness
-
- foreach my $oc ( @oc ) {
- my $oid = $self->is_objectclass( $oc );
- if( $oid ) {
- my $res = $self->{oid}->{$oid}->{$must_or_may} or next;
- @res{ @$res } = (); # Add in, getting uniqueness
- }
- }
-
- return wantarray ? (keys %res) : [ keys %res ];
-}
-
-
-#
-# Return the value of an item, e.g. 'desc'. If item is array ref and we
-# are called from array context, return an array, else scalar
-#
-sub item {
- my $self = shift;
- my $arg = shift;
- my $item_name = shift; # May be undef. If so all are returned
-
- my @oid = $self->name2oid( $arg );
- return _error($self, @oid ? "Non-unique name" : "Unknown name")
- unless @oid == 1;
+ my %res;
+ my %done;
- my $item_ref = $self->{oid}->{$oid[0]} or return _error($self, "Unknown OID");
+ while (@oc) {
+ my $oc = shift @oc;
- my $value = defined($item_name) ? $item_ref->{lc $item_name} : $item_ref
- or return _error($self, "No such property");
- delete $self->{error};
+ $done{lc $oc}++ and next;
- if( ref $value eq "ARRAY" && wantarray ) {
- return @$value;
- }
- else {
- return $value;
+ my $elem = $self->objectclass( $oc ) or next;
+ my $res = $elem->{$must_or_may} or next;
+ @res{ @$res } = (); # Add in, getting uniqueness
+ my $sup = $elem->{sup} or next;
+ push @oc, @$sup;
}
-}
-
-#
-# Return a list of items for a particular name or oid
-#
-# BUG:Dumps internal representation rather than real info. E.g. shows
-# the alias/name distinction we create and the 'type' field.
-#
-sub items {
- my $self = shift;
- my $arg = shift;
- my @oid = $self->name2oid( $arg );
- return _error($self, @oid ? "Non-unique name" : "Unknown name")
- unless @oid == 1;
-
- my $item_ref = $self->{oid}->{$oid[0]} or return _error($self, "Unknown OID");
- delete $self->{error};
-
- return wantarray ? (keys %$item_ref) : [keys %$item_ref];
-}
-
-#
-# Given a name, alias or oid, return oid or undef. Undef if not known.
-#
-sub name2oid {
- my $self = shift;
- my $name = lc shift;
- return _error($self, "Bad name") unless defined($name) && length($name);
- return $name if exists $self->{oid}->{$name}; # Already an oid
- my $oid = $self->{name}->{$name} || $self->{aliases}->{$name}
- or return _error($self, "Unknown name");
- return (wantarray && ref $oid) ? @$oid : $oid;
-}
-
-#
-# Given an an OID (not a name) return the canonical name. Undef if not
-# an OID
-#
-sub oid2name {
- my $self = shift;
- my $oid = shift;
- return _error($self, "Bad OID") unless $oid;
- return _error($self, "Unknown OID") unless $self->{oid}->{$oid};
- delete $self->{error};
- return $self->{oid}->{$oid}->{name};
+ my %unique = map { ($_,$_) } $self->attribute(keys %res);
+ values %unique;
}
#
-# Given name or oid, return oid or undef if not of appropriate type
+# Given name or oid, return element or undef if not of appropriate type
#
-sub is_attribute {
- my $self = shift;
- return $self->_is_type( "at", @_ );
-}
-
-sub is_objectclass {
- my $self = shift;
- return $self->_is_type( "oc", @_ );
-}
-
-sub is_syntax {
- my $self = shift;
- return $self->_is_type( "syn", @_ );
-}
-sub is_matchingrule {
- my $self = shift;
- return $self->_is_type( "mr", @_ );
-}
-
-sub is_matchingruleuse {
+sub _get {
my $self = shift;
- return $self->_is_type( "mru", @_ );
-}
+ my $type = $self->{ pop(@_) };
+ my $oid = $self->{oid};
-sub is_ditstructurerule {
- my $self = shift;
- return $self->_is_type( "dts", @_ );
-}
+ my @elem = grep $_, map {
+ my $elem = $type->{lc $_};
-sub is_ditcontentrule {
- my $self = shift;
- return $self->_is_type( "dtc", @_ );
-}
+ ($elem or ($elem = $oid->{$_} and $elem->{type} eq $type))
+ ? $elem
+ : undef;
+ } @_;
-sub is_nameform {
- my $self = shift;
- return $self->_is_type( "nfm", @_ );
+ wantarray ? @elem : $elem[0];
}
-# --------------------------------------------------
-# Internal functions
-# --------------------------------------------------
-
-#
-# Given a type and a name_or_oid, return true (the oid) if the name_or_oid
-# is of the appropriate type. Else return undef.
-#
-sub _is_type {
- my ($self, $type, $name) = @_;
-
- foreach my $oid ($self->name2oid( $name )) {
- my $hash = $self->{oid}->{$oid} or next;
- return $oid if $hash->{type} eq $type;
- }
-
- undef;
-}
+sub attribute { _get(@_,'at') }
+sub objectclass { _get(@_,'oc') }
+sub syntax { _get(@_,'syn') }
+sub matchingrule { _get(@_,'mr') }
+sub matchingruleuse { _get(@_,'mru') }
+sub ditstructurerule { _get(@_,'dts') }
+sub ditcontentrule { _get(@_,'dtc') }
+sub nameform { _get(@_,'nfm') }
#
@@ -399,22 +221,17 @@
# ... etc per oid details
#
# These next items are optimisations, to avoid always searching the OID
-# lists. Could be removed in theory.
-#
-# ->{at} = [ list of canonical names of attributes ]
-# ->{oc} = [ list of can. names of objectclasses ]
-# ->{syn} = [ list of can. names of syntaxes (we make names from descripts) ]
-# ->{mr} = [ list of can. names of matchingrules ]
-# ->{mru} = [ list of can. names of matchingruleuse ]
-# ->{dts} = [ list of can. names of ditstructurerules ]
-# ->{dtc} = [ list of can. names of ditcontentrules ]
-# ->{nfm} = [ list of can. names of nameForms ]
-#
-# This is used to optimise name => oid lookups (to avoid searching).
-# This could be removed or made into a cache to reduce memory usage.
-# The names include any aliases.
+# lists. Could be removed in theory. Each is a hash ref mapping
+# lowercase names to the hash stored in the oid struucture
#
-# ->{name}->{ $lower_case_name } = $oid
+# ->{at}
+# ->{oc}
+# ->{syn}
+# ->{mr}
+# ->{mru}
+# ->{dts}
+# ->{dtc}
+# ->{nfm}
#
#
@@ -439,15 +256,16 @@
#
# Map schema attribute names to internal names
#
-my %type2attr = ( at => "attributetypes",
- oc => "objectclasses",
- syn => "ldapsyntaxes",
- mr => "matchingrules",
- mru => "matchingruleuse",
- dts => "ditstructurerules",
- dtc => "ditcontentrules",
- nfm => "nameforms",
- );
+my %type2attr = qw(
+ at attributetypes
+ oc objectclasses
+ syn ldapsyntaxes
+ mr matchingrules
+ mru matchingruleuse
+ dts ditstructurerules
+ dtc ditcontentrules
+ nfm nameforms
+);
#
# Return ref to hash containing schema data - undef on failure
@@ -456,15 +274,15 @@
sub _parse_schema {
my $schema = shift;
my $entry = shift;
-
+
return undef unless defined($entry);
keys %type2attr; # reset iterator
while(my($type,$attr) = each %type2attr) {
my $vals = $entry->get_value($attr, asref => 1);
- my @names;
- $schema->{$type} = \@names; # Save reference to list of names
+ my %names;
+ $schema->{$type} = \%names; # Save reference to hash of names => element
next unless $vals; # Just leave empty ref if nothing
@@ -495,7 +313,7 @@
|
'((?:[^']+|'[^\s)])*)'
)\s*/xcg;
- die "Cannot parse [$val] ",substr($val,pos($val)) unless @tokens and pos($val) == length($val);
+ die "Cannot parse [$val] [",substr($val,pos($val)),"]" unless @tokens and pos($val) == length($val);
# remove () from start/end
shift @tokens if $tokens[0] eq '(';
@@ -520,7 +338,7 @@
push @arr,$tmp unless $tmp eq '$';
# Drop of end of list ?
- die "Cannot parse [$val]" unless @tokens;
+ die "Cannot parse [$val] {$tag}" unless @tokens;
}
}
@@ -529,50 +347,42 @@
if exists $listops{$tag} and !ref $schema_entry{$tag};
}
else {
- die "Cannot parse [$val]";
+ die "Cannot parse [$val] {$tag}";
}
}
#
# Extract the maximum length of a syntax
#
- if ( exists $schema_entry{syntax}) {
- $schema_entry{syntax} =~ s/{(\d+)}//
- and $schema_entry{max_length} = $1;
- }
+ $schema_entry{max_length} = $1
+ if exists $schema_entry{syntax} and $schema_entry{syntax} =~ s/{(\d+)}//;
#
# Force a name if we don't have one
#
- if (!exists $schema_entry{name}) {
- $schema_entry{name} = $schema_entry{oid};
- }
+ $schema_entry{name} = $schema_entry{oid}
+ unless exists $schema_entry{name};
#
# If we have multiple names, make the name be the first and demote the rest to aliases
#
- $schema_entry{name} = shift @{$schema_entry{aliases} = $schema_entry{name}}
- if ref $schema_entry{name};
+ if (ref $schema_entry{name}) {
+ my $aliases;
+ $schema_entry{name} = shift @{$aliases = $schema_entry{name}};
+ $schema_entry{aliases} = $aliases if @$aliases;
+ }
#
- # In the schema we store:
- #
- # 1 - The schema entry referenced by OID
- # 2 - a list of canonical names of each type
- # 3 - a (lower-cased) canonical name -> OID map
- # 4 - a (lower-cased) alias -> OID map
+ # Store the elements by OID
#
$schema->{oid}->{$oid} = \%schema_entry;
- my $uc_name = uc $schema_entry{name};
- push @names, $uc_name;
- foreach my $name ( @{$schema_entry{aliases}}, $uc_name ) {
- if (exists $schema->{name}{lc $name}) {
- $schema->{name}{lc $name} = [ $schema->{name}{lc $name} ] unless ref $schema->{name}{lc $name};
- push @{$schema->{name}{lc $name}}, $oid;
- }
- else {
- $schema->{name}{lc $name} = $oid;
- }
+
+ #
+ # We also index elements by name within each type
+ #
+ foreach my $name ( @{$schema_entry{aliases}}, $schema_entry{name} ) {
+ my $lc_name = lc $name;
+ $names{lc $name} = \%schema_entry;
}
}
}
@@ -587,31 +397,22 @@
#
# Get the syntax of an attribute
#
-sub syntax {
+sub attribute_syntax {
my $self = shift;
my $attr = shift;
+ my $syntax;
- my $oid = $self->is_attribute( $attr ) or return undef;
+ while ($attr) {
+ my $elem = $self->attribute( $attr ) or return undef;
- my $syntax = $self->{oid}->{$oid}->{syntax};
- unless( $syntax ) {
- my @sup = @{$self->{oid}->{$oid}->{sup}};
- $syntax = $self->syntax( $sup[0] );
+ $syntax = $elem->{syntax} and return $self->syntax($syntax);
+
+ $attr = ${$elem->{sup} || []}[0];
}
- return $syntax;
+ return undef
}
-#
-# Given an OID or name (or alias), return the canonical name
-#
-sub name {
- my $self = shift;
- my $arg = shift;
- my @oid = $self->name2oid( $arg );
- return undef unless @oid == 1;
- return $self->oid2name( $oid[0] );
-}
sub error {
$_[0]->{error};
Index: Schema.pod
===================================================================
RCS file: /cvsroot/perl-ldap/ldap/lib/Net/LDAP/Schema.pod,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -d -r1.10 -r1.11
--- Schema.pod 24 Aug 2001 19:31:14 -0000 1.10
+++ Schema.pod 23 Apr 2002 10:57:29 -0000 1.11
@@ -34,38 +34,50 @@
=over 4
-=item attributes
+=item all_attributes
-With no arguments, returns a list of the names all attributes in the schema.
+=item all_ditcontentrules
- @atts = $schema->attributes();
+=item all_ditstructurerules
-If called with an argument which is the name or oid of a known object class,
-returns a list of the attributes which may (or must) be present in the OC.
+=item all_matchingrules
- @person_atts = $schema->attributes( "person" );
+=item all_matchingruleuses
-Return value is an array or array reference depending on calling context, or
-empty list on error.
+=item all_nameforms
-=item ditstructurerules
+=item all_objectclasses
-Returns a list of the names of all ditstructurerules in the schema.
+=item all_syntaxes
- @dts = $schema->ditstructurerules();
+Returns a list of the names all the requested type in the schema
-Return value is an array or array reference depending on calling context.
+ @attrs = $schema->all_attributes();
-=item ditcontentrules
+=item attribute NAME_OR_OID
-Returns a list of the names of all ditcontentrules in the schema.
+=item ditcontentrule NAME_OR_OID
- @dtc = $schema->ditcontentrules();
+=item ditstructurerule NAME_OR_OID
-Return value is an array or array reference depending on calling context.
+=item matchingrule NAME_OR_OID
+
+=item matchingruleuse NAME_OR_OID
+
+=item nameform NAME_OR_OID
+
+=item objectclass NAME_OR_OID
+
+=item syntax NAME_OR_OID
+
+Returns a reference to a hash, or undef if the attribute does not exist.
+
+ $attr_href = $schema->attribute( "attrname" );
=item dump
+=item dump FILENAME
+
Given an argument which is the name of a file, and the file or
directory has write permission, will dump the raw schema
information to a file. If no argument is given the raw schema
@@ -84,127 +96,29 @@
Returns the last error encountered.
-=item is_objectclass, is_attribute, is_syntax, is_matchingrule
-
-Given the name or oid of a schema item (object class, attribute,
-syntax or matchingrule respectively) returns the assoicated OID
-or undef if the name or oid is not of the appropriate type.
-
- # Is foo a known OC?
- $oid = $schema->is_objectclass( "foo" );
- # No? Bale out.
- die( "Not an objectclass" ) unless $oid;
- # Yes...so we can do this
- @must = $schema->must( $oid );
-
-
-=item is_matchingruleuse, is_ditstructurerule, is_ditcontentrule, is_nameform
-
Given the name or oid of a schema item (matchingruleuse, ditstructurerule,
ditcontentrule or nameform respectively) returns the assoicated OID
or undef if the name or oid is not of the appropriate type.
- # Is foo a known OC?
- $oid = $schema->is_nameform( "foo" );
- # No? Bale out.
- die( "Not a nameform" ) unless $oid;
-
-=item item
-
-Given two arguments, first of which is the name or oid of a known
-object class or attribute and second of which is the name of the
-item, returns the item's data value. The item's value may be
-undefined.
-
- @item = $schema->item( $oid, "desc" );
-
-Return value is an array or a value depending on calling context.
-
-If the first argument is a name and there is more than one item in the
-schema with that name then undef, or the empty list, will be returned.
-
-=item items
-
-Given an argument which is the name or oid of a known object class or
-attribute, returns the items available for this attribute or object class.
-The returned item name may have an undefined value.
-
- @items = $schema->items( $oid );
-
-Return value is a list or array reference depending on calling context.
-
-If the argument given is a name and there is more than one item in the
-schema with that name then undef, or the empty list, will be returned.
-
-=item matchingrules
-
-Returns a list of the names of all matchingrules in the schema.
-
- @mrs = $schema->matchingrules();
-
-Return value is an array or array reference depending on calling context.
-
-=item matchingruleuse
-
-Returns a list of the names of all matchingruleuse in the schema.
-
- @mru = $schema->matchingruleuse();
-
-Return value is an array or array reference depending on calling context.
-
=item may
Given an argument which is the name or oid of a known object class, returns
-the name of the attributes which are optional in the class.
+the names of the attributes which are optional in the class.
@may = $schema->may( $oc );
-Return value is an array or array reference depending on calling context.
-
=item must
Given an argument which is the name or oid of a known object class, returns
-the name of the attributes which are mandatory in the class
+the names of the attributes which are mandatory in the class
@must = $schema->must( $oc );
-Return value is an array or array reference depending on calling context.
-
-=item name
-
-Given an argument which is the name or oid of an item,
-returns the items canonical name or undef if the name or oid is not known.
-
-If the argument given is a name and there is more than one item in the
-schema with that name then undef will be returned.
-
-=item name2oid
-
-Given the name of a schema item (object class, attribute or syntax) returns
-the assoicated OID or undef if it is not recognised.
-
-It is possible that two objects, of different types, have the same name.
-In this case C<name2oid> will return a list of OIDs in an array context.
-In a scalar context it will return undef if there is more than one object
-with the given name.
-
-=item nameforms
-
-Returns a list of the names of all nameforms in the schema.
-
- @nfm = $schema->nameforms();
-
-Return value is an array or array reference depending on calling context.
-
-=item objectclasses
-
-Returns a list of the names of all objectclasses in the schema.
-
- @ocs = $schema->objectclasses();
+=item parse MESG
-Return value is an array or array reference depending on calling context.
+=item parse ENTRY
-=item parse
+=item parse FILENAME
Takes a single argument which can be any of, A message objected returned from
an LDAP search, a Net::LDAP::Entry object or the name of a file containing
@@ -219,23 +133,6 @@
Given an argument which is the name or oid of a known objectclass, returns
the list of names of the immediate superclasses.
-
-=item syntax
-
-Given an argument which is the name or oid of a known attribute, returns the
-name of the attribute's syntax (or the syntax of the attributes superior
-if the syntax is inherited).
-
- $name_syntax = $schema->syntax( "commonName" );
-
-=item syntaxes
-
-Returns a list of the names of all ldapSyntaxes in the schema. (The name of
-a syntax is not well defined. It may be an OID or abbreviated description).
-
- @syns = $schema->syntaxes();
-
-Return value is an array or array reference depending on calling context.
=back
|
|
From: Graham B. <gb...@us...> - 2002-04-23 10:52:59
|
Update of /cvsroot/perl-ldap/ldap/lib/Net/LDAP
In directory usw-pr-cvs1:/tmp/cvs-serv31925/lib/Net/LDAP
Modified Files:
LDIF.pm
Log Message:
Support line continuations in LDIF files in comments.
Patch from Norbert Klasen
Index: LDIF.pm
===================================================================
RCS file: /cvsroot/perl-ldap/ldap/lib/Net/LDAP/LDIF.pm,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -d -r1.15 -r1.16
--- LDIF.pm 4 Feb 2002 14:58:35 -0000 1.15
+++ LDIF.pm 23 Apr 2002 10:52:55 -0000 1.16
@@ -80,8 +80,8 @@
$self->eof(1);
return;
}
- $ln =~ s/^#.*\n//mg;
$ln =~ s/\n //sg;
+ $ln =~ s/^#.*\n//mg;
chomp($ln);
$self->{_current_lines} = $ln;
chomp(@ldif = split(/^/, $ln));
|
|
From: Graham B. <gb...@us...> - 2002-03-31 14:40:19
|
Update of /cvsroot/perl-ldap/sasl In directory usw-pr-cvs1:/tmp/cvs-serv11977 Modified Files: ChangeLog Log Message: Release 2.01 Index: ChangeLog =================================================================== RCS file: /cvsroot/perl-ldap/sasl/ChangeLog,v retrieving revision 1.1 retrieving revision 1.2 diff -u -d -r1.1 -r1.2 --- ChangeLog 31 Jan 2002 17:00:32 -0000 1.1 +++ ChangeLog 31 Mar 2002 14:40:15 -0000 1.2 @@ -1,7 +1,25 @@ +2002-03-31 15:39 Graham Barr + + * lib/Authen/SASL.pm: + + Release 2.01 + +2002-03-22 10:13 Graham Barr + + * t/cram_md5.t: + + Skip cram_md5 test if Digest::HMAC_MD5 is not installed + +2002-02-18 16:56 Graham Barr + + * lib/Authen/SASL/Perl.pm: + + Add securesocket to the ::Perl base class. + 2002-01-28 19:52 Graham Barr - * lib/Authen/SASL.pm, t/anon.t, t/callback.t, t/cram_md5.t, - t/external.t, t/plain.t: + * MANIFEST, lib/Authen/SASL.pm, t/anon.t, t/callback.t, + t/cram_md5.t, t/external.t, t/plain.t: Add some tests @@ -13,10 +31,10 @@ 2002-01-24 12:04 Graham Barr - * Makefile.PL, api.txt, compat_pl, example_pl, lib/Authen/SASL.pm, - lib/Authen/SASL.pod, lib/Authen/SASL/CRAM_MD5.pm, - lib/Authen/SASL/EXTERNAL.pm, lib/Authen/SASL/Perl.pm, - lib/Authen/SASL/Perl/ANONYMOUS.pm, + * MANIFEST, Makefile.PL, api.txt, compat_pl, example_pl, + lib/Authen/SASL.pm, lib/Authen/SASL.pod, + lib/Authen/SASL/CRAM_MD5.pm, lib/Authen/SASL/EXTERNAL.pm, + lib/Authen/SASL/Perl.pm, lib/Authen/SASL/Perl/ANONYMOUS.pm, lib/Authen/SASL/Perl/CRAM_MD5.pm, lib/Authen/SASL/Perl/EXTERNAL.pm, lib/Authen/SASL/Perl/PLAIN.pm: @@ -24,10 +42,10 @@ 2002-01-24 12:04 Graham Barr - * Makefile.PL, api.txt, compat_pl, example_pl, lib/Authen/SASL.pm, - lib/Authen/SASL.pod, lib/Authen/SASL/CRAM_MD5.pm, - lib/Authen/SASL/EXTERNAL.pm, lib/Authen/SASL/Perl.pm, - lib/Authen/SASL/Perl/ANONYMOUS.pm, + * MANIFEST, Makefile.PL, api.txt, compat_pl, example_pl, + lib/Authen/SASL.pm, lib/Authen/SASL.pod, + lib/Authen/SASL/CRAM_MD5.pm, lib/Authen/SASL/EXTERNAL.pm, + lib/Authen/SASL/Perl.pm, lib/Authen/SASL/Perl/ANONYMOUS.pm, lib/Authen/SASL/Perl/CRAM_MD5.pm, lib/Authen/SASL/Perl/EXTERNAL.pm, lib/Authen/SASL/Perl/PLAIN.pm: |
|
From: Graham B. <gb...@us...> - 2002-03-31 14:39:36
|
Update of /cvsroot/perl-ldap/sasl/lib/Authen In directory usw-pr-cvs1:/tmp/cvs-serv11794/lib/Authen Modified Files: SASL.pm Log Message: Release 2.01 Index: SASL.pm =================================================================== RCS file: /cvsroot/perl-ldap/sasl/lib/Authen/SASL.pm,v retrieving revision 1.2 retrieving revision 1.3 diff -u -d -r1.2 -r1.3 --- SASL.pm 28 Jan 2002 19:52:25 -0000 1.2 +++ SASL.pm 31 Mar 2002 14:39:32 -0000 1.3 @@ -8,7 +8,7 @@ use vars qw($VERSION @Plugins); use Carp; -$VERSION = "2.00"; +$VERSION = "2.01"; @Plugins = qw( Authen::SASL::Cyrus |
|
From: Graham B. <gb...@us...> - 2002-03-25 14:59:32
|
Update of /cvsroot/perl-ldap/asn/t
In directory usw-pr-cvs1:/tmp/cvs-serv9296/t
Modified Files:
00prim.t 01tag.t 02seq.t 03seqof.t 04opt.t 05time.t 06bigint.t
08set.t 09contr.t 11indef.t
Log Message:
Add more detail when tests fail
Index: 00prim.t
===================================================================
RCS file: /cvsroot/perl-ldap/asn/t/00prim.t,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -d -r1.7 -r1.8
--- 00prim.t 10 Feb 2002 16:12:17 -0000 1.7
+++ 00prim.t 25 Mar 2002 14:59:27 -0000 1.8
@@ -47,7 +47,7 @@
print "# NULL\n";
$buf = pack("C*", 0x05, 0x00);
-btest 23, $asn->prepare(' null NULL ');
+btest 23, $asn->prepare(' null NULL ') or warn $asn->error;
stest 24, $buf, $asn->encode(null => 1) or warn $asn->error;
btest 25, $ret = $asn->decode($buf) or warn $asn->error;
btest 26, $ret->{'null'};
@@ -63,9 +63,9 @@
my $result = pack("C*", 0x01, 0x01, $val ? 0xFF : 0);
- btest $test++, $asn->prepare(' bool BOOLEAN');
- stest $test++, $result, $asn->encode(bool => $val);
- btest $test++, $ret = $asn->decode($result);
+ btest $test++, $asn->prepare(' bool BOOLEAN') or warn $asn->error;
+ stest $test++, $result, $asn->encode(bool => $val) or warn $asn->error;
+ btest $test++, $ret = $asn->decode($result) or warn $asn->error;
ntest $test++, !!$val, !!$ret->{'bool'};
}
@@ -87,9 +87,9 @@
while(($result,$val) = each %INTEGER) {
print "# INTEGER $val\n";
- btest $test++, $asn->prepare(' integer INTEGER');
- stest $test++, $result, $asn->encode(integer => $val);
- btest $test++, $ret = $asn->decode($result);
+ btest $test++, $asn->prepare(' integer INTEGER') or warn $asn->error;
+ stest $test++, $result, $asn->encode(integer => $val) or warn $asn->error;
+ btest $test++, $ret = $asn->decode($result) or warn $asn->error;
ntest $test++, $val, $ret->{integer};
}
@@ -98,8 +98,8 @@
$result = pack("C*", 0x02, 0x01, 0x09);
-stest $test++, $result, $asn->encode(9);
-btest $test++, $ret = $asn->decode($result);
+stest $test++, $result, $asn->encode(9) or warn $asn->error;
+btest $test++, $ret = $asn->decode($result) or warn $asn->error;
btest $test++, $ret == 9;
##
@@ -114,9 +114,9 @@
while(($result,$val) = each %STRING) {
print "# STRING '$val'\n";
- btest $test++, $asn->prepare('str STRING');
- stest $test++, $result, $asn->encode(str => $val);
- btest $test++, $ret = $asn->decode($result);
+ btest $test++, $asn->prepare('str STRING') or warn $asn->error;
+ stest $test++, $result, $asn->encode(str => $val) or warn $asn->error;
+ btest $test++, $ret = $asn->decode($result) or warn $asn->error;
stest $test++, $val, $ret->{'str'};
}
@@ -133,9 +133,9 @@
while(($result,$val) = each %OBJECT_ID) {
print "# OBJECT_ID $val\n";
- btest $test++, $asn->prepare('oid OBJECT IDENTIFIER');
- stest $test++, $result, $asn->encode(oid => $val);
- btest $test++, $ret = $asn->decode($result);
+ btest $test++, $asn->prepare('oid OBJECT IDENTIFIER') or warn $asn->error;
+ stest $test++, $result, $asn->encode(oid => $val) or warn $asn->error;
+ btest $test++, $ret = $asn->decode($result) or warn $asn->error;
stest $test++, $val, $ret->{'oid'};
}
@@ -152,9 +152,9 @@
while(($result,$val) = each %ENUM) {
print "# ENUM $val\n";
- btest $test++, $asn->prepare('enum ENUMERATED');
- stest $test++, $result, $asn->encode(enum => $val);
- btest $test++, $ret = $asn->decode($result);
+ btest $test++, $asn->prepare('enum ENUMERATED') or warn $asn->error;
+ stest $test++, $result, $asn->encode(enum => $val) or warn $asn->error;
+ btest $test++, $ret = $asn->decode($result) or warn $asn->error;
ntest $test++, $val, $ret->{'enum'};
}
@@ -180,9 +180,9 @@
print "# BIT STRING ", unpack("B*", ref($val) ? $val->[0] : $val),
" ",(ref($val) ? $val->[1] : $val),"\n";
- btest $test++, $asn->prepare('bit BIT STRING');
- stest $test++, $result, $asn->encode( bit => $val);
- btest $test++, $ret = $asn->decode($result);
+ btest $test++, $asn->prepare('bit BIT STRING') or warn $asn->error;
+ stest $test++, $result, $asn->encode( bit => $val) or warn $asn->error;
+ btest $test++, $ret = $asn->decode($result) or warn $asn->error;
stest $test++, (ref($val) ? $val->[2] : $val), $ret->{'bit'}[0];
ntest $test++, (ref($val) ? $val->[1] : 8*length$val), $ret->{'bit'}[1];
@@ -204,9 +204,9 @@
while(($result,$val) = each %REAL) {
print "# REAL $val\n";
- btest $test++, $asn->prepare('real REAL');
- stest $test++, $result, $asn->encode( real => $val);
- btest $test++, $ret = $asn->decode($result);
+ btest $test++, $asn->prepare('real REAL') or warn $asn->error;
+ stest $test++, $result, $asn->encode( real => $val) or warn $asn->error;
+ btest $test++, $ret = $asn->decode($result) or warn $asn->error;
ntest $test++, $val, $ret->{'real'};
}
@@ -223,9 +223,9 @@
while(($result,$val) = each %ROID) {
print "# RELATIVE-OID $val\n";
- btest $test++, $asn->prepare('roid RELATIVE-OID');
- stest $test++, $result, $asn->encode(roid => $val);
- btest $test++, $ret = $asn->decode($result);
+ btest $test++, $asn->prepare('roid RELATIVE-OID') or warn $asn->error;
+ stest $test++, $result, $asn->encode(roid => $val) or warn $asn->error;
+ btest $test++, $ret = $asn->decode($result) or warn $asn->error;
stest $test++, $val, $ret->{'roid'};
}
Index: 01tag.t
===================================================================
RCS file: /cvsroot/perl-ldap/asn/t/01tag.t,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- 01tag.t 22 May 2000 11:07:36 -0000 1.2
+++ 01tag.t 25 Mar 2002 14:59:28 -0000 1.3
@@ -9,49 +9,49 @@
print "1..21\n";
-btest 1, $asn = Convert::ASN1->new;
+btest 1, $asn = Convert::ASN1->new or warn $asn->error;
btest 2, $asn->prepare(q(
integer [0] INTEGER
-));
+)) or warn $asn->error;
$result = pack("C*", 0x80, 0x01, 0x08);
-stest 3, $result, $asn->encode(integer => 8);
-btest 4, $ret = $asn->decode($result);
+stest 3, $result, $asn->encode(integer => 8) or warn $asn->error;
+btest 4, $ret = $asn->decode($result) or warn $asn->error;
ntest 5, 8, $ret->{integer};
btest 6, $asn->prepare(q(
integer [APPLICATION 1] INTEGER
-));
+)) or warn $asn->error;
$result = pack("C*", 0x41, 0x01, 0x08);
-stest 7, $result, $asn->encode(integer => 8);
-btest 8, $ret = $asn->decode($result);
+stest 7, $result, $asn->encode(integer => 8) or warn $asn->error;
+btest 8, $ret = $asn->decode($result) or warn $asn->error;
ntest 9, 8, $ret->{integer};
btest 10, $asn->prepare(q(
integer [CONTEXT 2] INTEGER
-));
+)) or warn $asn->error;
$result = pack("C*", 0x82, 0x01, 0x08);
-stest 11, $result, $asn->encode(integer => 8);
-btest 12, $ret = $asn->decode($result);
+stest 11, $result, $asn->encode(integer => 8) or warn $asn->error;
+btest 12, $ret = $asn->decode($result) or warn $asn->error;
ntest 13, 8, $ret->{integer};
btest 14, $asn->prepare(q(
integer [UNIVERSAL 3] INTEGER
-));
+)) or warn $asn->error;
$result = pack("C*", 0x03, 0x01, 0x08);
-stest 15, $result, $asn->encode(integer => 8);
-btest 16, $ret = $asn->decode($result);
+stest 15, $result, $asn->encode(integer => 8) or warn $asn->error;
+btest 16, $ret = $asn->decode($result) or warn $asn->error;
ntest 17, 8, $ret->{integer};
btest 18, $asn->prepare(q(
integer [PRIVATE 4] INTEGER
-));
+)) or warn $asn->error;
$result = pack("C*", 0xc4, 0x01, 0x08);
-stest 19, $result, $asn->encode(integer => 8);
-btest 20, $ret = $asn->decode($result);
+stest 19, $result, $asn->encode(integer => 8) or warn $asn->error;
+btest 20, $ret = $asn->decode($result) or warn $asn->error;
ntest 21, 8, $ret->{integer};
Index: 02seq.t
===================================================================
RCS file: /cvsroot/perl-ldap/asn/t/02seq.t,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- 02seq.t 11 Jun 2001 13:04:11 -0000 1.3
+++ 02seq.t 25 Mar 2002 14:59:28 -0000 1.4
@@ -10,7 +10,7 @@
print "1..18\n";
-btest 1, $asn = Convert::ASN1->new;
+btest 1, $asn = Convert::ASN1->new or warn $asn->error;
btest 2, $asn->prepare(q(
SEQUENCE {
integer INTEGER,
@@ -23,8 +23,8 @@
0x04, 0x08, 0x41, 0x20, 0x73, 0x74, 0x72, 0x69,
0x6E, 0x67
);
-stest 3, $result, $asn->encode(integer => 1, bool => 0, str => "A string");
-btest 4, $ret = $asn->decode($result);
+stest 3, $result, $asn->encode(integer => 1, bool => 0, str => "A string") or warn $asn->error;
+btest 4, $ret = $asn->decode($result) or warn $asn->error;
ntest 5, 1, $ret->{integer};
ntest 6, 0, $ret->{bool};
stest 7, "A string", $ret->{str};
@@ -36,8 +36,8 @@
str STRING
}
)) or warn $asn->error;
-stest 9, $result, $asn->encode(seq => { integer => 1, bool => 0, str => "A string" });
-btest 10, $ret = $asn->decode($result);
+stest 9, $result, $asn->encode(seq => { integer => 1, bool => 0, str => "A string" }) or warn $asn->error;
+btest 10, $ret = $asn->decode($result) or warn $asn->error;
ntest 11, 1, $ret->{seq}{integer};
ntest 12, 0, $ret->{seq}{bool};
stest 13, "A string", $ret->{seq}{str};
@@ -53,7 +53,7 @@
real2 REAL
}
)) or warn $asn->error;
-stest 15, $result, $asn->encode( real => 6.78, real2 => 12.34);
-btest 16, $ret = $asn->decode($result);
+stest 15, $result, $asn->encode( real => 6.78, real2 => 12.34) or warn $asn->error;
+btest 16, $ret = $asn->decode($result) or warn $asn->error;
ntest 17, 6.78, $ret->{real};
ntest 18, 12.34, $ret->{real2};
Index: 03seqof.t
===================================================================
RCS file: /cvsroot/perl-ldap/asn/t/03seqof.t,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- 03seqof.t 10 Feb 2002 16:12:17 -0000 1.3
+++ 03seqof.t 25 Mar 2002 14:59:28 -0000 1.4
@@ -10,14 +10,14 @@
print "1..35\n";
-btest 1, $asn = Convert::ASN1->new;
-btest 2, $asn->prepare(' ints SEQUENCE OF INTEGER ');
+btest 1, $asn = Convert::ASN1->new or warn $asn->error;
+btest 2, $asn->prepare(' ints SEQUENCE OF INTEGER ') or warn $asn->error;
$result = pack("C*", 0x30, 0x0C, 0x02, 0x01, 0x09, 0x02, 0x01, 0x05,
0x02, 0x01, 0x03, 0x02, 0x01, 0x01);
-stest 3, $result, $asn->encode(ints => [9,5,3,1]);
-btest 4, $ret = $asn->decode($result);
+stest 3, $result, $asn->encode(ints => [9,5,3,1]) or warn $asn->error;
+btest 4, $ret = $asn->decode($result) or warn $asn->error;
btest 5, exists $ret->{'ints'};
stest 6, "9:5:3:1", join(":", @{$ret->{'ints'}});
@@ -47,9 +47,9 @@
seq => [
{ str => 'fred', val => [qw(a b c)] },
{ str => 'joe', val => [qw(q w e)] }
- ]);
+ ]) or warn $asn->error;
-btest 9, $ret = $asn->decode($result);
+btest 9, $ret = $asn->decode($result) or warn $asn->error;
ntest 10, 1, scalar keys %$ret;
btest 11, exists $ret->{'seq'};
ntest 12, 2, scalar @{$ret->{'seq'}};
@@ -58,8 +58,8 @@
stest 15, "a:b:c", join(":", @{$ret->{'seq'}[0]{'val'}});
stest 16, "q:w:e", join(":", @{$ret->{'seq'}[1]{'val'}});
-btest 17, $asn = Convert::ASN1->new;
-btest 18, $asn->prepare(<<'EOS');
+btest 17, $asn = Convert::ASN1->new or warn $asn->error;
+btest 18, $asn->prepare(<<'EOS') or warn $asn->error;
AttributeTypeAndValue ::= SEQUENCE {
type STRING,
@@ -76,7 +76,7 @@
EOS
-btest 19, $asn = $asn->find('Issuer');
+btest 19, $asn = $asn->find('Issuer') or warn $asn->error;
$result = pack("C*",
0x30, 0x26, 0x30, 0x24, 0x31, 0x10, 0x30, 0x06,
@@ -93,9 +93,9 @@
[{ type => "3", value => "c" }, { type => "4", value => "d" }],
]
}
-);
+) or warn $asn->error;
-btest 21, $ret = $asn->decode($result);
+btest 21, $ret = $asn->decode($result) or warn $asn->error;
ntest 22, 1, $ret->{issuer}{rdnSequence}[0][0]{type};
ntest 23, 2, $ret->{issuer}{rdnSequence}[0][1]{type};
@@ -108,13 +108,13 @@
stest 29, 'd', $ret->{issuer}{rdnSequence}[1][1]{value};
-btest 30, $asn = Convert::ASN1->new;
-btest 31, $asn->prepare('test ::= SEQUENCE OF INTEGER ');
+btest 30, $asn = Convert::ASN1->new or warn $asn->error;
+btest 31, $asn->prepare('test ::= SEQUENCE OF INTEGER ') or warn $asn->error;
$result = pack("C*", 0x30, 0x0C, 0x02, 0x01, 0x09, 0x02, 0x01, 0x05,
0x02, 0x01, 0x03, 0x02, 0x01, 0x01);
-stest 32, $result, $asn->encode([9,5,3,1]);
-btest 33, $ret = $asn->decode($result);
+stest 32, $result, $asn->encode([9,5,3,1]) or warn $asn->error;
+btest 33, $ret = $asn->decode($result) or warn $asn->error;
btest 34, ref($ret) eq 'ARRAY';
stest 35, "9:5:3:1", join(":", @{$ret});
Index: 04opt.t
===================================================================
RCS file: /cvsroot/perl-ldap/asn/t/04opt.t,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- 04opt.t 22 May 2000 11:07:36 -0000 1.2
+++ 04opt.t 25 Mar 2002 14:59:28 -0000 1.3
@@ -9,21 +9,21 @@
print "1..12\n"; # This testcase needs more tests
-btest 1, $asn = Convert::ASN1->new;
+btest 1, $asn = Convert::ASN1->new or warn $asn->error;
btest 2, $asn->prepare(q(
integer INTEGER OPTIONAL,
str STRING
)) or warn $asn->error;
$result = pack("C*", 0x4, 0x3, ord('a'), ord('b'), ord('c'));
-stest 3, $result, $asn->encode(str => "abc");
-btest 4, $ret = $asn->decode($result);
+stest 3, $result, $asn->encode(str => "abc") or warn $asn->error;
+btest 4, $ret = $asn->decode($result) or warn $asn->error;
stest 5, "abc", $ret->{str};
btest 6, !exists $ret->{integer};
$result = pack("C*", 0x2, 0x1, 0x9, 0x4, 0x3, ord('a'), ord('b'), ord('c'));
-stest 7, $result, $asn->encode(integer => 9, str => "abc");
-btest 8, $ret = $asn->decode($result);
+stest 7, $result, $asn->encode(integer => 9, str => "abc") or warn $asn->error;
+btest 8, $ret = $asn->decode($result) or warn $asn->error;
stest 9, "abc", $ret->{str};
btest 10, exists $ret->{integer};
ntest 11, 9, $ret->{integer};
Index: 05time.t
===================================================================
RCS file: /cvsroot/perl-ldap/asn/t/05time.t,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- 05time.t 26 Apr 2001 06:52:04 -0000 1.2
+++ 05time.t 25 Mar 2002 14:59:28 -0000 1.3
@@ -14,8 +14,8 @@
my $t = 1;
-btest $t++, $asn = Convert::ASN1->new;
-btest $t++, $asn->prepare('date UTCTime');
+btest $t++, $asn = Convert::ASN1->new or warn $asn->error;
+btest $t++, $asn->prepare('date UTCTime') or warn $asn->error;
my $time = 987718268; # 2001-04-19 22:11:08 GMT
my $result;
@@ -30,8 +30,8 @@
);
$asn->configure( encode => { timezone => +3600 } );
-stest $t++, $result, $asn->encode(date => $time);
-btest $t++, $ret = $asn->decode($result);
+stest $t++, $result, $asn->encode(date => $time) or warn $asn->error;
+btest $t++, $ret = $asn->decode($result) or warn $asn->error;
ntest $t++, $time, $ret->{date};
# 2 hours ahead
@@ -43,8 +43,8 @@
);
$asn->configure( encode => { timezone => +7200 } );
-stest $t++, $result, $asn->encode(date => $time);
-btest $t++, $ret = $asn->decode($result);
+stest $t++, $result, $asn->encode(date => $time) or warn $asn->error;
+btest $t++, $ret = $asn->decode($result) or warn $asn->error;
ntest $t++, $time, $ret->{date};
# zulu
@@ -55,14 +55,14 @@
);
$asn->configure( encode => { 'time' => 'utctime' } );
-stest $t++, $result, $asn->encode(date => $time);
-btest $t++, $ret = $asn->decode($result);
+stest $t++, $result, $asn->encode(date => $time) or warn $asn->error;
+btest $t++, $ret = $asn->decode($result) or warn $asn->error;
ntest $t++, $time, $ret->{date};
# 1 hour ahead
-btest $t++, $asn = Convert::ASN1->new;
-btest $t++, $asn->prepare('date GeneralizedTime');
+btest $t++, $asn = Convert::ASN1->new or warn $asn->error;
+btest $t++, $asn->prepare('date GeneralizedTime') or warn $asn->error;
$result = pack("C*",
0x18, 0x13, 0x32, 0x30, 0x30, 0x31, 0x30, 0x34, 0x31, 0x39,
0x32, 0x33, 0x31, 0x31, 0x30, 0x38, 0x2B, 0x30,
@@ -70,14 +70,14 @@
);
$asn->configure( encode => { timezone => +3600 } );
-stest $t++, $result, $asn->encode(date => $time);
-btest $t++, $ret = $asn->decode($result);
+stest $t++, $result, $asn->encode(date => $time) or warn $asn->error;
+btest $t++, $ret = $asn->decode($result) or warn $asn->error;
ntest $t++, $time, $ret->{date};
# 4 hours behind
-btest $t++, $asn = Convert::ASN1->new;
-btest $t++, $asn->prepare('date GeneralizedTime');
+btest $t++, $asn = Convert::ASN1->new or warn $asn->error;
+btest $t++, $asn->prepare('date GeneralizedTime') or warn $asn->error;
$result = pack("C*",
0x18, 0x13, 0x32, 0x30, 0x30, 0x31, 0x30, 0x34, 0x31, 0x39,
0x31, 0x38, 0x31, 0x31, 0x30, 0x38, 0x2D, 0x30,
@@ -85,8 +85,8 @@
);
$asn->configure( encode => { timezone => -14400 } );
-stest $t++, $result, $asn->encode(date => $time);
-btest $t++, $ret = $asn->decode($result);
+stest $t++, $result, $asn->encode(date => $time) or warn $asn->error;
+btest $t++, $ret = $asn->decode($result) or warn $asn->error;
ntest $t++, $time, $ret->{date};
# fractional second
@@ -99,7 +99,7 @@
);
$asn->configure( encode => { timezone => +3600 } );
-stest $t++, $result, $asn->encode(date => $time);
-btest $t++, $ret = $asn->decode($result);
+stest $t++, $result, $asn->encode(date => $time) or warn $asn->error;
+btest $t++, $ret = $asn->decode($result) or warn $asn->error;
ntest $t++, $time, $ret->{date};
Index: 06bigint.t
===================================================================
RCS file: /cvsroot/perl-ldap/asn/t/06bigint.t,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -d -r1.5 -r1.6
--- 06bigint.t 21 Jan 2002 20:00:11 -0000 1.5
+++ 06bigint.t 25 Mar 2002 14:59:28 -0000 1.6
@@ -11,7 +11,7 @@
print "1..59\n";
-btest 1, $asn = Convert::ASN1->new;
+btest 1, $asn = Convert::ASN1->new or warn $asn->error;
btest 2, $asn->prepare(q(
integer INTEGER
)) or warn $asn->error;
@@ -25,37 +25,37 @@
$result = pack("C*", 0x2, 0x13, 0x30, 0xfd, 0x65, 0xc1, 0x01, 0xd9,
0xea, 0x2c, 0x94, 0x9e, 0xc5, 0x08, 0x50, 0x4a,
0x90, 0x43, 0xdb, 0x52, 0xdd);
-stest 3, $result, $asn->encode(integer => $num);
-btest 4, $ret = $asn->decode($result);
+stest 3, $result, $asn->encode(integer => $num) or warn $asn->error;
+btest 4, $ret = $asn->decode($result) or warn $asn->error;
btest 5, exists $ret->{integer};
btest 6, ref($ret->{integer}) eq 'Math::BigInt';
ntest 7, $num, $ret->{integer};
$num = (1<<17) * (1<<17);
$result = pack("C*", 0x2, 0x5, 0x4, 0x0, 0x0, 0x0, 0x0);
-stest 8, $result, $asn->encode(integer => $num);
-btest 9, $ret = $asn->decode($result);
+stest 8, $result, $asn->encode(integer => $num) or warn $asn->error;
+btest 9, $ret = $asn->decode($result) or warn $asn->error;
btest 10, exists $ret->{integer};
ntest 11, $num, $ret->{integer};
$num += 10;
$result = pack("C*", 0x2, 0x5, 0x4, 0x0, 0x0, 0x0, 0xa);
-stest 12, $result, $asn->encode(integer => $num);
-btest 13, $ret = $asn->decode($result);
+stest 12, $result, $asn->encode(integer => $num) or warn $asn->error;
+btest 13, $ret = $asn->decode($result) or warn $asn->error;
btest 14, exists $ret->{integer};
ntest 15, $num, $ret->{integer};
$num = -$num;
$result = pack("C*", 0x2, 0x5, 0xfb, 0xff, 0xff, 0xff, 0xf6);
-stest 16, $result, $asn->encode(integer => $num);
-btest 17, $ret = $asn->decode($result);
+stest 16, $result, $asn->encode(integer => $num) or warn $asn->error;
+btest 17, $ret = $asn->decode($result) or warn $asn->error;
btest 18, exists $ret->{integer};
ntest 19, $num, $ret->{integer};
$num += 10;
$result = pack("C*", 0x2, 0x5, 0xfc, 0x0, 0x0, 0x0, 0x0);
-stest 20, $result, $asn->encode(integer => $num);
-btest 21, $ret = $asn->decode($result);
+stest 20, $result, $asn->encode(integer => $num) or warn $asn->error;
+btest 21, $ret = $asn->decode($result) or warn $asn->error;
btest 22, exists $ret->{integer};
ntest 23, $num, $ret->{integer};
@@ -63,8 +63,8 @@
$result = pack("C*", 0x2, 0x13, 0xcf, 0x2, 0x9a, 0x3e, 0xfe, 0x26,
0x15, 0xd3, 0x6b, 0x61, 0x3a, 0xf7, 0xaf, 0xb5,
0x6f, 0xbc, 0x24, 0xad, 0x23);
-stest 24, $result, $asn->encode(integer => $num);
-btest 25, $ret = $asn->decode($result);
+stest 24, $result, $asn->encode(integer => $num) or warn $asn->error;
+btest 25, $ret = $asn->decode($result) or warn $asn->error;
btest 26, exists $ret->{integer};
ntest 27, $num, $ret->{integer};
@@ -74,15 +74,15 @@
$result = pack("C*", 0x2, 0x15, 0x00, 0xe9, 0x8a, 0x5e, 0xb8, 0x3a,
0xfa, 0x3d, 0x4, 0x13, 0x7d, 0x19, 0xfc, 0x39,
0x36, 0xa3, 0x2b, 0xd2, 0x22, 0x06, 0xc7);
-stest 28, $result, $asn->encode(integer => $num);
-btest 29, $ret = $asn->decode($result);
+stest 28, $result, $asn->encode(integer => $num) or warn $asn->error;
+btest 29, $ret = $asn->decode($result) or warn $asn->error;
btest 30, exists $ret->{integer};
ntest 31, $num, $ret->{integer};
$num = Math::BigInt->new(-1 * (1<<24)) * Math::BigInt->new(1<<24);
$result = pack("C*", 0x2, 0x7, 0xff, 0x0, 0x0, 0x0, 0x0, 0x0, 0x0);
-stest 32, $result, $asn->encode(integer => $num);
-btest 33, $ret = $asn->decode($result);
+stest 32, $result, $asn->encode(integer => $num) or warn $asn->error;
+btest 33, $ret = $asn->decode($result) or warn $asn->error;
btest 34, exists $ret->{integer};
ntest 35, $num, $ret->{integer};
@@ -100,9 +100,9 @@
while(($result,$val) = each %INTEGER) {
print "# INTEGER $val\n";
- btest $test++, $asn->prepare(' integer INTEGER');
- stest $test++, $result, $asn->encode(integer => $val);
- btest $test++, $ret = $asn->decode($result);
+ btest $test++, $asn->prepare(' integer INTEGER') or warn $asn->error;
+ stest $test++, $result, $asn->encode(integer => $val) or warn $asn->error;
+ btest $test++, $ret = $asn->decode($result) or warn $asn->error;
ntest $test++, $val, $ret->{integer};
}
Index: 08set.t
===================================================================
RCS file: /cvsroot/perl-ldap/asn/t/08set.t,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- 08set.t 10 Sep 2001 14:35:22 -0000 1.1
+++ 08set.t 25 Mar 2002 14:59:28 -0000 1.2
@@ -10,7 +10,7 @@
print "1..13\n";
-btest 1, $asn = Convert::ASN1->new;
+btest 1, $asn = Convert::ASN1->new or warn $asn->error;
btest 2, $asn->prepare(q(
SET {
integer INTEGER,
@@ -23,14 +23,14 @@
0x04, 0x08, 0x41, 0x20, 0x73, 0x74, 0x72, 0x69,
0x6E, 0x67
);
-stest 3, $result, $asn->encode(integer => 9, bool => 0, str => "A string");
+stest 3, $result, $asn->encode(integer => 9, bool => 0, str => "A string") or warn $asn->error;
btest 4, $ret = $asn->decode($result) or warn $asn->error;
ntest 5, 9, $ret->{integer};
ntest 6, 0, $ret->{bool};
stest 7, "A string", $ret->{str};
-btest 8, $asn = Convert::ASN1->new;
+btest 8, $asn = Convert::ASN1->new or warn $asn->error;
btest 9, $asn->prepare(q(
SET {
bool BOOLEAN,
Index: 09contr.t
===================================================================
RCS file: /cvsroot/perl-ldap/asn/t/09contr.t,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- 09contr.t 10 Sep 2001 14:35:22 -0000 1.1
+++ 09contr.t 25 Mar 2002 14:59:28 -0000 1.2
@@ -1,7 +1,7 @@
#!/usr/local/bin/perl
#
-# Test the use of sets
+# Test the decode on constructed values
#
use Convert::ASN1;
@@ -10,7 +10,7 @@
print "1..4\n";
-btest 1, $asn = Convert::ASN1->new;
+btest 1, $asn = Convert::ASN1->new or warn $asn->error;
btest 2, $asn->prepare(q(
str STRING
)) or warn $asn->error;
Index: 11indef.t
===================================================================
RCS file: /cvsroot/perl-ldap/asn/t/11indef.t,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- 11indef.t 25 Mar 2002 09:06:18 -0000 1.1
+++ 11indef.t 25 Mar 2002 14:59:28 -0000 1.2
@@ -11,18 +11,17 @@
print "1..7\n";
-btest 1, $asn = Convert::ASN1->new;
-btest 2, $asn->prepare( <<'[TheEnd]' );
-GroupOfThis ::= [1] OCTET STRING
-GroupOfThat ::= [2] OCTET STRING
-Item ::= [3] SEQUENCE {
- aGroup GroupOfThis OPTIONAL,
- bGroup GroupOfThat OPTIONAL
-}
-Items ::= [4] SEQUENCE OF Item
-List ::= [5] SEQUENCE { list Items }
-
-[TheEnd]
+btest 1, $asn = Convert::ASN1->new or warn $asn->error;
+btest 2, $asn->prepare(q(
+ GroupOfThis ::= [1] OCTET STRING
+ GroupOfThat ::= [2] OCTET STRING
+ Item ::= [3] SEQUENCE {
+ aGroup GroupOfThis OPTIONAL,
+ bGroup GroupOfThat OPTIONAL
+ }
+ Items ::= [4] SEQUENCE OF Item
+ List ::= [5] SEQUENCE { list Items }
+)) or warn $asn->error;
my $buf = pack( 'C*',
0xa5, 0x80,
@@ -38,13 +37,13 @@
0x82, 0x03, ( ord('D') ) x 3,
@zz,
@zz,
- @zz, );
+ @zz,
+);
my $nl = $asn->find( 'List' );
-my $seq = $nl->decode( $buf );
+my $seq = $nl->decode( $buf ) or warn $asn->error;
btest 3, defined( $seq ) && exists( $seq->{list} );
-stest 4, $seq->{list}->[0]->{aGroup}, 'AAA';
-stest 5, $seq->{list}->[1]->{bGroup}, 'BBB';
-stest 6, $seq->{list}->[2]->{aGroup}, 'CCC';
-stest 7, $seq->{list}->[2]->{bGroup}, 'DDD';
-
+stest 4, 'AAA', $seq->{list}->[0]->{aGroup};
+stest 5, 'BBB', $seq->{list}->[1]->{bGroup};
+stest 6, 'CCC', $seq->{list}->[2]->{aGroup};
+stest 7, 'DDD', $seq->{list}->[2]->{bGroup};
|
|
From: Graham B. <gb...@us...> - 2002-03-25 09:06:22
|
Update of /cvsroot/perl-ldap/asn/t
In directory usw-pr-cvs1:/tmp/cvs-serv20416/t
Added Files:
10choice.t 11indef.t
Log Message:
Patch from Wolfgang Laun
Fix bug in decode when there are nested CHOICEs
Add tests t/10choice.t t/11indef.t
--- NEW FILE: 10choice.t ---
#!/usr/local/bin/perl
#
# Test the use of choices
#
use Convert::ASN1;
BEGIN { require 't/funcs.pl' }
print "1..7\n";
btest 1, $asn = Convert::ASN1->new;
btest 2, $asn->prepare( <<'[TheEnd]' ) or warn $asn->error;
Natural ::= CHOICE {
prime Prime,
product Product
}
Prime ::= [1] INTEGER
Product ::= CHOICE {
perfect Perfect,
plain Plain
}
Perfect ::= [2] INTEGER
Plain ::= [3] INTEGER
Naturals ::= [4] SEQUENCE OF Natural
List ::= [5] SEQUENCE { list Naturals }
[TheEnd]
my $nl = $asn->find( 'List' );
my $buf = $nl->encode( list => [
{ prime => 13 },
{ product => { perfect => 28 } },
{ product => { plain => 42 } }, ] );
$result = pack( 'C*', 0xa5, 0x0b, 0xa4, 0x09,
0x81, 0x01, 0x0d,
0x82, 0x01, 0x1c,
0x83, 0x01, 0x2a, );
stest 3, $result, $buf;
my $seq = $nl->decode( $buf ) or warn $asn->error;
btest 4, defined( $seq ) && exists( $seq->{list} );
ntest 5, 13, $seq->{list}->[0]->{prime};
ntest 6, 28, $seq->{list}->[1]->{product}->{perfect};
ntest 7, 42, $seq->{list}->[2]->{product}->{plain};
--- NEW FILE: 11indef.t ---
#!/usr/local/bin/perl
#
# Test that indefinite length encodings can be decoded
#
BEGIN { require 't/funcs.pl' }
use Convert::ASN1;
my @zz = ( 0, 0 );
print "1..7\n";
btest 1, $asn = Convert::ASN1->new;
btest 2, $asn->prepare( <<'[TheEnd]' );
GroupOfThis ::= [1] OCTET STRING
GroupOfThat ::= [2] OCTET STRING
Item ::= [3] SEQUENCE {
aGroup GroupOfThis OPTIONAL,
bGroup GroupOfThat OPTIONAL
}
Items ::= [4] SEQUENCE OF Item
List ::= [5] SEQUENCE { list Items }
[TheEnd]
my $buf = pack( 'C*',
0xa5, 0x80,
0xa4, 0x80,
0xa3, 0x80,
0x81, 0x03, ( ord('A') ) x 3,
@zz,
0xa3, 0x80,
0x82, 0x03, ( ord('B') ) x 3,
@zz,
0xa3, 0x80,
0x81, 0x03, ( ord('C') ) x 3,
0x82, 0x03, ( ord('D') ) x 3,
@zz,
@zz,
@zz, );
my $nl = $asn->find( 'List' );
my $seq = $nl->decode( $buf );
btest 3, defined( $seq ) && exists( $seq->{list} );
stest 4, $seq->{list}->[0]->{aGroup}, 'AAA';
stest 5, $seq->{list}->[1]->{bGroup}, 'BBB';
stest 6, $seq->{list}->[2]->{aGroup}, 'CCC';
stest 7, $seq->{list}->[2]->{bGroup}, 'DDD';
|
|
From: Graham B. <gb...@us...> - 2002-03-25 09:06:22
|
Update of /cvsroot/perl-ldap/asn In directory usw-pr-cvs1:/tmp/cvs-serv20416 Modified Files: MANIFEST Log Message: Patch from Wolfgang Laun Fix bug in decode when there are nested CHOICEs Add tests t/10choice.t t/11indef.t Index: MANIFEST =================================================================== RCS file: /cvsroot/perl-ldap/asn/MANIFEST,v retrieving revision 1.7 retrieving revision 1.8 diff -u -d -r1.7 -r1.8 --- MANIFEST 10 Feb 2002 16:41:28 -0000 1.7 +++ MANIFEST 25 Mar 2002 09:06:19 -0000 1.8 @@ -25,4 +25,6 @@ t/07io.t t/08set.t t/09contr.t +t/10choice.t +t/11indef.t t/funcs.pl |
|
From: Graham B. <gb...@us...> - 2002-03-25 09:06:20
|
Update of /cvsroot/perl-ldap/asn/lib/Convert/ASN1
In directory usw-pr-cvs1:/tmp/cvs-serv20416/lib/Convert/ASN1
Modified Files:
_decode.pm
Log Message:
Patch from Wolfgang Laun
Fix bug in decode when there are nested CHOICEs
Add tests t/10choice.t t/11indef.t
Index: _decode.pm
===================================================================
RCS file: /cvsroot/perl-ldap/asn/lib/Convert/ASN1/_decode.pm,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -d -r1.14 -r1.15
--- _decode.pm 25 Mar 2002 07:46:08 -0000 1.14
+++ _decode.pm 25 Mar 2002 09:06:16 -0000 1.15
@@ -163,6 +163,36 @@
next OP;
}
+ unless (length $cop->[cTAG]) {
+ eval {
+ _decode(
+ $optn,
+ [$cop],
+ (\my %tmp_stash),
+ $pos,
+ $npos+$len+$indef,
+ undef,
+ $indef ? $larr : [],
+ $buf,
+ );
+
+ my $nstash = $seqof
+ ? ($seqof->[$idx++]={})
+ : defined($var)
+ ? ($stash->{$var}={})
+ : ref($stash) eq 'SCALAR'
+ ? ($$stash={}) : $stash;
+
+ @{$nstash}{keys %tmp_stash} = values %tmp_stash;
+
+ } or next;
+
+ $pos = $npos+$len+$indef;
+
+ redo CHOICELOOP if $seqof && $pos < $end;
+ next OP;
+ }
+
if ($tag eq ($cop->[cTAG] | chr(ASN_CONSTRUCTOR))
and my $ctr = $ctr[$cop->[cTYPE]])
{
|
|
From: Graham B. <gb...@us...> - 2002-03-25 07:46:11
|
Update of /cvsroot/perl-ldap/asn/lib/Convert/ASN1
In directory usw-pr-cvs1:/tmp/cvs-serv2349/lib/Convert/ASN1
Modified Files:
_decode.pm
Log Message:
Patch from Wolfgang Laun
Addition of prepare_file and the change prepare to accept a filehandle.
POD updates.
Fix decode of nested indefinate lengths
Index: _decode.pm
===================================================================
RCS file: /cvsroot/perl-ldap/asn/lib/Convert/ASN1/_decode.pm,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -d -r1.13 -r1.14
--- _decode.pm 10 Feb 2002 16:12:16 -0000 1.13
+++ _decode.pm 25 Mar 2002 07:46:08 -0000 1.14
@@ -518,6 +518,7 @@
sub _decode_tl {
my($pos,$end,$larr) = @_[1,2,3];
+
my $indef = 0;
my $tag = substr($_[0], $pos++, 1);
@@ -561,16 +562,17 @@
sub _scan_indef {
my($pos,$end,$larr) = @_[1,2,3];
- @$larr = ();
- my @depth = ( $pos );
+ @$larr = ( $pos );
+ my @depth = ( \$larr->[0] );
while(@depth) {
return if $pos+2 > $end;
if (substr($_[0],$pos,2) eq "\0\0") {
my $end = $pos;
- my $start = shift @depth;
- unshift @$larr, $end-$start;
+ my $stref = shift @depth;
+ # replace pos with length = end - pos
+ $$stref = $end - $$stref;
$pos += 2;
next;
}
@@ -579,7 +581,6 @@
if((ord($tag) & 0x1f) == 0x1f) {
my $b;
- my $n=1;
do {
$tag .= substr($_[0],$pos++,1);
$b = ord substr($tag,-1);
@@ -596,7 +597,9 @@
$pos += $len + unpack("N", "\0" x (4 - $len) . substr($_[0],$pos,$len));
}
else {
- unshift @depth, $pos;
+ # reserve another list element
+ push @$larr, $pos;
+ unshift @depth, \$larr->[-1];
}
}
else {
|
|
From: Graham B. <gb...@us...> - 2002-03-25 07:46:11
|
Update of /cvsroot/perl-ldap/asn/lib/Convert
In directory usw-pr-cvs1:/tmp/cvs-serv2349/lib/Convert
Modified Files:
ASN1.pm ASN1.pod
Log Message:
Patch from Wolfgang Laun
Addition of prepare_file and the change prepare to accept a filehandle.
POD updates.
Fix decode of nested indefinate lengths
Index: ASN1.pm
===================================================================
RCS file: /cvsroot/perl-ldap/asn/lib/Convert/ASN1.pm,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -d -r1.21 -r1.22
--- ASN1.pm 10 Feb 2002 16:12:16 -0000 1.21
+++ ASN1.pm 25 Mar 2002 07:46:08 -0000 1.22
@@ -13,7 +13,7 @@
BEGIN {
@ISA = qw(Exporter);
- $VERSION = '0.15_01';
+ $VERSION = '0.15_02';
%EXPORT_TAGS = (
io => [qw(asn_recv asn_send asn_read asn_write asn_get asn_ready)],
@@ -128,17 +128,38 @@
my $asn = shift;
$self = $self->new unless ref($self);
-
- my $tree = Convert::ASN1::parser::parse($asn);
+ my $tree;
+ if( ref($asn) eq 'GLOB' ){
+ local $/ = undef;
+ my $txt = <$asn>;
+ $tree = Convert::ASN1::parser::parse($txt);
+ } else {
+ $tree = Convert::ASN1::parser::parse($asn);
+ }
unless ($tree) {
$self->{error} = $@;
return;
+ ### If $self has been set to a new object, not returning
+ ### this object here will destroy the object, so the caller
+ ### won't be able to get at the error.
}
$self->{tree} = _pack_struct($tree);
$self->{script} = (values %$tree)[0];
$self;
+}
+
+sub prepare_file {
+ my $self = shift;
+ my $asnp = shift;
+
+ local *ASN;
+ open( ASN, $asnp )
+ or do{ $self->{error} = $@; return; };
+ my $ret = $self->prepare( \*ASN );
+ close( ASN );
+ $ret;
}
# In XS the will convert the tree between perl and C structs
Index: ASN1.pod
===================================================================
RCS file: /cvsroot/perl-ldap/asn/lib/Convert/ASN1.pod,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -d -r1.5 -r1.6
--- ASN1.pod 22 Jan 2002 11:24:28 -0000 1.5
+++ ASN1.pod 25 Mar 2002 07:46:08 -0000 1.6
@@ -155,14 +155,19 @@
=head2 prepare ( ASN )
-Compile the given ASN.1 descripton. The syntax used is very close to ASN.1, but has
-a few differnces. If the ASN decribes only one macro then encode/decode can be
+Compile the given ASN.1 descripton which can be passed as a string
+or as a filehandle. The syntax used is very close to ASN.1, but has
+a few differences. If the ASN decribes only one macro then encode/decode can be
called on this object. If ASN describes more than one ASN.1 macro then C<find>
-must be called.
+must be called. The method returns undef on error.
+
+=head2 prepare_file ( ASNPATH )
+
+Compile the ASN.1 description to be read from the specified pathname.
=head2 find ( MACRO )
-Find a macro froma prepared ASN.1 description. Returns an object which can
+Find a macro from a prepared ASN.1 description. Returns an object which can
be used for encode/decode.
=head2 encode ( VARIABLES )
@@ -178,7 +183,7 @@
=head1 EXPORTS
As well as providing an object interface for encoding/decoding PDUs Convert::ASN1
-also provides the follow functions.
+also provides the following functions.
=head2 IO Functions
@@ -193,7 +198,7 @@
cases the empty string will be returned. This is the same behaviour
as the C<recv> function in perl itself.
-It is reccomended that if the socket is of type SOCK_DGRAM then C<recv>
+It is recommended that if the socket is of type SOCK_DGRAM then C<recv>
be called directly instead of calling C<asn_recv>.
=item asn_read FH, BUFFER, OFFSET
@@ -223,7 +228,7 @@
C<asn_get> provides buffered IO. Because it needs a buffer FH must be a GLOB
or a reference to a GLOB. C<asn_get> will use two entries in the hash element
-of the GLOB to use as it's buffer
+of the GLOB to use as its buffer:
asn_buffer - input buffer
asn_need - number of bytes needed for the next element, if known
|
|
From: Graham B. <gb...@us...> - 2002-03-25 07:39:49
|
Update of /cvsroot/perl-ldap/asn/lib/Convert/ASN1
In directory usw-pr-cvs1:/tmp/cvs-serv1329/lib/Convert/ASN1
Modified Files:
parser.pm
Log Message:
Allow '-'s in names and fix an uninit warning in the generated parser
Index: parser.pm
===================================================================
RCS file: /cvsroot/perl-ldap/asn/lib/Convert/ASN1/parser.pm,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -d -r1.7 -r1.8
--- parser.pm 22 Jan 2002 11:24:28 -0000 1.7
+++ parser.pm 25 Mar 2002 07:39:46 -0000 1.8
@@ -210,7 +210,7 @@
{
if (($yyn = $yysindex[$yyss[$yyssp]]) &&
($yyn += constYYERRCODE()) >= 0 &&
- $yycheck[$yyn] == constYYERRCODE())
+ $yyn <= $#yycheck && $yycheck[$yyn] == constYYERRCODE())
{
@@ -271,7 +271,7 @@
}
if (($yyn = $yysindex[$yystate]) && ($yyn += $yychar) >= 0 &&
- $yycheck[$yyn] == $yychar)
+ $yyn <= $#yycheck && $yycheck[$yyn] == $yychar)
{
@@ -284,7 +284,7 @@
next yyloop;
}
if (($yyn = $yyrindex[$yystate]) && ($yyn += $yychar) >= 0 &&
- $yycheck[$yyn] == $yychar)
+ $yyn <= $#yycheck && $yycheck[$yyn] == $yychar)
{
$yyn = $yytable[$yyn];
last yyreduce;
@@ -835,7 +835,7 @@
RELATIVE-OID
)\b
|
- (\w+)
+ (\w+(?:-\w+)*)
|
\[\s*
(
@@ -899,12 +899,12 @@
# 947 "y.tab.pl"
-%yystate = ('State20','','State21','','State43','','State27','','State28',
-'','State45','','State29','','State46','','State47','','State48','',
-'State1','','State3','','State4','','State5','','State11','','State14','',
-'State30','','State31','','State32','','State33','','State18','','State34',
-'','State50','','State19','','State35','','State51','','State36','',
-'State52','','State37','','State53','','State38','','State54','','State39',
-'','State55','','State56','','State57','');
+%yystate = ('State20','','State11','','State30','','State21','','State31',
+'','State50','','State32','','State14','','State51','','State33','',
+'State52','','State43','','State34','','State53','','State35','','State54',
+'','State45','','State36','','State18','','State27','','State55','',
+'State46','','State37','','State19','','State28','','State56','','State47',
+'','State38','','State29','','State57','','State48','','State39','',
+'State1','','State3','','State4','','State5','');
1;
|
|
From: Graham B. <gb...@us...> - 2002-03-25 07:39:49
|
Update of /cvsroot/perl-ldap/asn
In directory usw-pr-cvs1:/tmp/cvs-serv1329
Modified Files:
mkparse parser.y
Log Message:
Allow '-'s in names and fix an uninit warning in the generated parser
Index: mkparse
===================================================================
RCS file: /cvsroot/perl-ldap/asn/mkparse,v
retrieving revision 1.1.1.1
retrieving revision 1.2
diff -u -d -r1.1.1.1 -r1.2
--- mkparse 3 May 2000 12:24:43 -0000 1.1.1.1
+++ mkparse 25 Mar 2002 07:39:46 -0000 1.2
@@ -49,6 +49,9 @@
s/^if \(\$yyn == (\d+)\s*\)/State$1:/ and $state{"State$1"} = '';
}
+ # fix an uninit bug
+ s/^(\s*)(?=\$yycheck\[\$yyn\]\s+==)/$1\$yyn <= \$#yycheck && /;
+
print OUT;
# Print the goto for the switch
Index: parser.y
===================================================================
RCS file: /cvsroot/perl-ldap/asn/parser.y,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -d -r1.6 -r1.7
--- parser.y 22 Jan 2002 11:24:28 -0000 1.6
+++ parser.y 25 Mar 2002 07:39:46 -0000 1.7
@@ -493,7 +493,7 @@
RELATIVE-OID
)\b
|
- (\w+)
+ (\w+(?:-\w+)*)
|
\[\s*
(
|
|
From: Graham B. <gb...@us...> - 2002-03-22 10:13:26
|
Update of /cvsroot/perl-ldap/sasl/t
In directory usw-pr-cvs1:/tmp/cvs-serv5307/t
Modified Files:
cram_md5.t
Log Message:
Skip cram_md5 test if Digest::HMAC_MD5 is not installed
Index: cram_md5.t
===================================================================
RCS file: /cvsroot/perl-ldap/sasl/t/cram_md5.t,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- cram_md5.t 28 Jan 2002 19:52:25 -0000 1.1
+++ cram_md5.t 22 Mar 2002 10:13:21 -0000 1.2
@@ -3,6 +3,8 @@
@Authen::SASL::Plugins = qw(Authen::SASL::Perl);
+eval { require Digest::HMAC_MD5 } or print("1..0\n"), exit;
+
print "1..5\n";
my $sasl = Authen::SASL->new(
|
|
From: Graham B. <gb...@us...> - 2002-02-18 16:57:01
|
Update of /cvsroot/perl-ldap/sasl/lib/Authen/SASL
In directory usw-pr-cvs1:/tmp/cvs-serv7071/lib/Authen/SASL
Modified Files:
Perl.pm
Log Message:
Add securesocket to the ::Perl base class.
Index: Perl.pm
===================================================================
RCS file: /cvsroot/perl-ldap/sasl/lib/Authen/SASL/Perl.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- Perl.pm 24 Jan 2002 15:21:43 -0000 1.2
+++ Perl.pm 18 Feb 2002 16:56:58 -0000 1.3
@@ -8,7 +8,7 @@
use vars qw($VERSION);
use Carp;
-$VERSION = "1.00";
+$VERSION = "1.01";
my %secflags = (
noplaintext => 1,
@@ -99,6 +99,8 @@
}
sub _secflags { 0 }
+
+sub securesocket { $_[1] }
1;
|
|
From: Graham B. <gb...@us...> - 2002-02-18 16:51:46
|
Update of /cvsroot/perl-ldap/ldap/lib/Net/LDAP
In directory usw-pr-cvs1:/tmp/cvs-serv5539/lib/Net/LDAP
Modified Files:
Bind.pm
Log Message:
Change over to using Authen::SASL v2.00, which is now distributed
in a separate distribution
Index: Bind.pm
===================================================================
RCS file: /cvsroot/perl-ldap/ldap/lib/Net/LDAP/Bind.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- Bind.pm 31 Jan 2001 11:44:03 -0000 1.2
+++ Bind.pm 18 Feb 2002 16:51:42 -0000 1.3
@@ -5,7 +5,7 @@
package Net::LDAP::Bind;
use strict;
-use Net::LDAP qw(LDAP_SASL_BIND_IN_PROGRESS LDAP_DECODING_ERROR);
+use Net::LDAP qw(LDAP_SASL_BIND_IN_PROGRESS LDAP_DECODING_ERROR LDAP_SUCCESS);
use Net::LDAP::Message;
use vars qw(@ISA);
@@ -23,18 +23,22 @@
or $self->set_error(LDAP_DECODING_ERROR,"LDAP decode error")
and return;
+ my $sasl = $self->{sasl};
+ my $ldap = $self->parent;
+
+ $ldap->{net_ldap_socket} = $sasl->securesocket($ldap->{net_ldap_socket})
+ if $sasl and $bind->{resultCode} == LDAP_SUCCESS;
+
return $self->SUPER::decode($result)
unless $bind->{resultCode} == LDAP_SASL_BIND_IN_PROGRESS;
# tell our LDAP client to forget us as this message has now completed
# all communications with the server
- $self->parent->_forgetmesg($self);
+ $ldap->_forgetmesg($self);
$self->{mesgid} = Net::LDAP::Message->NewMesgID(); # Get a new message ID
- my $sasl = $self->{sasl};
- my $ldap = $self->parent;
- my $resp = $sasl->challenge($bind->{serverSaslCreds});
+ my $resp = $sasl->client_step($bind->{serverSaslCreds});
$self->encode(
bindRequest => {
@@ -42,7 +46,7 @@
name => $self->{dn},
authentication => {
sasl => {
- mechanism => $sasl->name,
+ mechanism => $sasl->mechanism,
credentials => $resp
}
},
|
|
From: Graham B. <gb...@us...> - 2002-02-18 16:51:46
|
Update of /cvsroot/perl-ldap/ldap/lib/Net
In directory usw-pr-cvs1:/tmp/cvs-serv5539/lib/Net
Modified Files:
LDAP.pm
Log Message:
Change over to using Authen::SASL v2.00, which is now distributed
in a separate distribution
Index: LDAP.pm
===================================================================
RCS file: /cvsroot/perl-ldap/ldap/lib/Net/LDAP.pm,v
retrieving revision 1.29
retrieving revision 1.30
diff -u -d -r1.29 -r1.30
--- LDAP.pm 18 Feb 2002 15:58:27 -0000 1.29
+++ LDAP.pm 18 Feb 2002 16:51:42 -0000 1.30
@@ -239,15 +239,26 @@
my $sasl = $passwd;
# Tell the SASL object our user identifier
- $sasl->user("dn: $dn") unless $sasl->user;
+ $sasl->callback( user => "dn: $stash{name}")
+ unless $sasl->callback('user');
+
+ my $sasl_conn = $sasl->client_new("ldap",$ldap->{net_ldap_host});
+
+ # Tell SASL the local and server IP addresses
+ $sasl_conn->property(
+ sockname => $ldap->{net_ldap_socket}->sockname,
+ peername => $ldap->{net_ldap_socket}->peername,
+ );
+
+ my $initial = $sasl_conn->client_start;
$passwd = {
- mechanism => $sasl->name,
- credentials => $sasl->initial
+ mechanism => $sasl_conn->mechanism,
+ credentials => $initial
};
# Save data, we will need it later
- $mesg->_sasl_info($stash{name},$control,$sasl);
+ $mesg->_sasl_info($stash{name},$control,$sasl_conn);
}
$stash{authentication} = { $auth_type => $passwd };
|
|
From: Graham B. <gb...@us...> - 2002-02-18 16:51:46
|
Update of /cvsroot/perl-ldap/ldap/lib/Authen/SASL In directory usw-pr-cvs1:/tmp/cvs-serv5539/lib/Authen/SASL Removed Files: CRAM_MD5.pm EXTERNAL.pm Log Message: Change over to using Authen::SASL v2.00, which is now distributed in a separate distribution --- CRAM_MD5.pm DELETED --- --- EXTERNAL.pm DELETED --- |
|
From: Graham B. <gb...@us...> - 2002-02-18 16:51:45
|
Update of /cvsroot/perl-ldap/ldap/lib/Authen In directory usw-pr-cvs1:/tmp/cvs-serv5539/lib/Authen Removed Files: SASL.pm SASL.pod Log Message: Change over to using Authen::SASL v2.00, which is now distributed in a separate distribution --- SASL.pm DELETED --- --- SASL.pod DELETED --- |
|
From: Graham B. <gb...@us...> - 2002-02-18 16:51:45
|
Update of /cvsroot/perl-ldap/ldap/htdocs
In directory usw-pr-cvs1:/tmp/cvs-serv5539/htdocs
Modified Files:
index.xml
Log Message:
Change over to using Authen::SASL v2.00, which is now distributed
in a separate distribution
Index: index.xml
===================================================================
RCS file: /cvsroot/perl-ldap/ldap/htdocs/index.xml,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- index.xml 24 Oct 2001 14:37:34 -0000 1.3
+++ index.xml 18 Feb 2002 16:51:41 -0000 1.4
@@ -49,7 +49,6 @@
<section>
<title>Other</title>
<group>
- <module>Authen::SASL</module>
<module>Bundle::Net::LDAP</module>
</group>
</section>
|
|
From: Graham B. <gb...@us...> - 2002-02-18 16:51:45
|
Update of /cvsroot/perl-ldap/ldap
In directory usw-pr-cvs1:/tmp/cvs-serv5539
Modified Files:
MANIFEST Makefile.PL
Log Message:
Change over to using Authen::SASL v2.00, which is now distributed
in a separate distribution
Index: MANIFEST
===================================================================
RCS file: /cvsroot/perl-ldap/ldap/MANIFEST,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -d -r1.16 -r1.17
--- MANIFEST 24 Oct 2001 14:37:34 -0000 1.16
+++ MANIFEST 18 Feb 2002 16:51:41 -0000 1.17
@@ -42,7 +42,6 @@
data/slapd.at.conf
data/slapd.oc.conf
data/slapd2-conf.in
-htdocs/Authen/SASL.html
htdocs/Bundle/Net/LDAP.html
htdocs/Net/LDAP.html
htdocs/Net/LDAP/Constant.html
@@ -71,10 +70,6 @@
htdocs/index.html
htdocs/index.xml
install-nomake
-lib/Authen/SASL.pm
-lib/Authen/SASL.pod
-lib/Authen/SASL/CRAM_MD5.pm
-lib/Authen/SASL/EXTERNAL.pm
lib/Bundle/Net/LDAP.pm
lib/LWP/Protocol/ldap.pm
lib/Net/LDAP.pm
Index: Makefile.PL
===================================================================
RCS file: /cvsroot/perl-ldap/ldap/Makefile.PL,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -d -r1.7 -r1.8
--- Makefile.PL 3 Dec 2001 16:20:26 -0000 1.7
+++ Makefile.PL 18 Feb 2002 16:51:41 -0000 1.8
@@ -71,6 +71,10 @@
The MIME::Base64 module is needed ONLY IF you intend to read/write LDIF files
EDQ
+check_module('Authen::SASL', 2.00) or print <<"EDQ","\n";
+If you intend to use SASL authentication you need at least version 2.00
+EDQ
+
print "\n",<<"EDQ","\n" if $missing;
****************************************************************************
You are missing some modules that MAY be needed for some of the features
|
|
From: Graham B. <gb...@us...> - 2002-02-18 15:58:30
|
Update of /cvsroot/perl-ldap/ldap/lib/Net
In directory usw-pr-cvs1:/tmp/cvs-serv21401/lib/Net
Modified Files:
LDAP.pm
Log Message:
Allow host passed to new to be an array ref of several to try
Index: LDAP.pm
===================================================================
RCS file: /cvsroot/perl-ldap/ldap/lib/Net/LDAP.pm,v
retrieving revision 1.28
retrieving revision 1.29
diff -u -d -r1.28 -r1.29
--- LDAP.pm 29 Oct 2001 17:29:15 -0000 1.28
+++ LDAP.pm 18 Feb 2002 15:58:27 -0000 1.29
@@ -22,7 +22,7 @@
LDAP_INAPPROPRIATE_AUTH
);
-$VERSION = 0.25;
+$VERSION = "0.25_01";
@ISA = qw(Net::LDAP::Extra);
$LDAP_VERSION = 2; # default LDAP protocol version
@@ -96,9 +96,15 @@
my $arg = &_options;
my $obj = bless {}, $type;
- $obj->_connect($host, $arg) or return;
+ foreach my $h (ref($host) ? @$host : ($host)) {
+ if ($obj->_connect($host, $arg)) {
+ $obj->{net_ldap_host} = $h;
+ last;
+ }
+ }
+
+ 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-02-15 06:51:50
|
Update of /cvsroot/perl-ldap/asn/lib/Convert/ASN1
In directory usw-pr-cvs1:/tmp/cvs-serv25775/lib/Convert/ASN1
Modified Files:
_encode.pm
Log Message:
Use ::isa to determine if stash argument is a HASH
Index: _encode.pm
===================================================================
RCS file: /cvsroot/perl-ldap/asn/lib/Convert/ASN1/_encode.pm,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -d -r1.14 -r1.15
--- _encode.pm 10 Feb 2002 16:12:17 -0000 1.14
+++ _encode.pm 15 Feb 2002 06:51:45 -0000 1.15
@@ -53,9 +53,9 @@
&{$encode[$op->[cTYPE]]}(
$optn,
$op,
- (ref($stash) ne 'HASH'
- ? ({}, $stash)
- : ($stash, defined($var) ? $stash->{$var} : undef)),
+ (UNIVERSAL::isa($stash, 'HASH')
+ ? ($stash, defined($var) ? $stash->{$var} : undef)
+ : ({}, $stash)),
$_[4],
$op->[cLOOP],
$path,
|
|
From: Graham B. <gb...@us...> - 2002-02-10 16:41:31
|
Update of /cvsroot/perl-ldap/asn In directory usw-pr-cvs1:/tmp/cvs-serv14396 Modified Files: MANIFEST Log Message: Added x509decode from Norbert Klasen Index: MANIFEST =================================================================== RCS file: /cvsroot/perl-ldap/asn/MANIFEST,v retrieving revision 1.6 retrieving revision 1.7 diff -u -d -r1.6 -r1.7 --- MANIFEST 10 Sep 2001 14:35:22 -0000 1.6 +++ MANIFEST 10 Feb 2002 16:41:28 -0000 1.7 @@ -5,6 +5,7 @@ README examples/ldap examples/ldap-search +examples/x509decode lib/Convert/ASN1.pm lib/Convert/ASN1.pod lib/Convert/ASN1/Debug.pm |
