diff -Nru libauthen-sasl-perl-2.12/Changes libauthen-sasl-perl-2.13/Changes --- libauthen-sasl-perl-2.12/Changes 2008-07-01 03:57:02.000000000 +0100 +++ libauthen-sasl-perl-2.13/Changes 2009-09-24 23:33:37.000000000 +0100 @@ -1,3 +1,10 @@ +Authen-SASL 2.13 -- Thu Sep 24 17:27:47 CDT 2009 + + * RT#42191 Only use pass for GSSAPI credentials if it is an object of type GSSAPI::Cred + * RT#675 Authorization with Authen::SASL::Perl::External + * Call client_new and server_new inside eval so further plugins can be tried before failing + * Prefer to use Authen::SASL::XS over Authen::SASL::Cyrus + Authen-SASL 2.12 -- Mon Jun 30 21:35:21 CDT 2008 Enhancements diff -Nru /tmp/MQ70iNNc2v/libauthen-sasl-perl-2.12/debian/changelog /tmp/c5NcsEjNyt/libauthen-sasl-perl-2.13/debian/changelog --- libauthen-sasl-perl-2.12/debian/changelog 2009-11-05 11:24:17.000000000 +0000 +++ libauthen-sasl-perl-2.13/debian/changelog 2009-11-05 11:24:17.000000000 +0000 @@ -1,3 +1,20 @@ +libauthen-sasl-perl (2.13-1) unstable; urgency=low + + [ Gunnar Wolf ] + * New upstream release + * Standards-version → 3.8.3 (no changes needed) + + [ gregor herrmann ] + * debian/control: Changed: Switched Vcs-Browser field to ViewSVN + (source stanza). + * debian/control: Added: ${misc:Depends} to Depends: field. + * Remove Florian Ragwitz from Uploaders (closes: #523154). + + [ Nathan Handler ] + * debian/watch: Update to ignore development releases. + + -- Gunnar Wolf Sun, 27 Sep 2009 14:02:26 -0500 + libauthen-sasl-perl (2.12-1) unstable; urgency=low * New upstream release diff -Nru /tmp/MQ70iNNc2v/libauthen-sasl-perl-2.12/debian/control /tmp/c5NcsEjNyt/libauthen-sasl-perl-2.13/debian/control --- libauthen-sasl-perl-2.12/debian/control 2009-11-05 11:24:17.000000000 +0000 +++ libauthen-sasl-perl-2.13/debian/control 2009-11-05 11:24:17.000000000 +0000 @@ -4,16 +4,16 @@ Build-Depends: debhelper (>= 5.0.0) Build-Depends-Indep: perl (>= 5.8.0-7), libdigest-hmac-perl Maintainer: Debian Perl Group -Uploaders: AGOSTINI Yves , Florian Ragwitz , Gunnar Wolf -Standards-Version: 3.8.0 +Uploaders: AGOSTINI Yves , Gunnar Wolf +Standards-Version: 3.8.3 Homepage: http://search.cpan.org/dist/Authen-SASL/ Vcs-Svn: svn://svn.debian.org/pkg-perl/trunk/libauthen-sasl-perl/ -Vcs-Browser: http://svn.debian.org/wsvn/pkg-perl/trunk/libauthen-sasl-perl/ +Vcs-Browser: http://svn.debian.org/viewsvn/pkg-perl/trunk/libauthen-sasl-perl/ Package: libauthen-sasl-perl Section: perl Architecture: all -Depends: ${perl:Depends} +Depends: ${misc:Depends}, ${perl:Depends} Suggests: libdigest-hmac-perl, libgssapi-perl Replaces: libnet-ldap-perl (<= 0.26-2) Description: Authen::SASL - SASL Authentication framework diff -Nru /tmp/MQ70iNNc2v/libauthen-sasl-perl-2.12/debian/watch /tmp/c5NcsEjNyt/libauthen-sasl-perl-2.13/debian/watch --- libauthen-sasl-perl-2.12/debian/watch 2009-11-05 11:24:17.000000000 +0000 +++ libauthen-sasl-perl-2.13/debian/watch 2009-11-05 11:24:17.000000000 +0000 @@ -1,4 +1,4 @@ # format version number, currently 3; this line is compulsory! version=3 # URL to the package page followed by a regex to search -http://search.cpan.org/dist/Authen-SASL/ .*/Authen-SASL-v?(\d[\d_.-]+)\.(?:tar(?:\.gz|\.bz2)?|tgz|zip)$ +http://search.cpan.org/dist/Authen-SASL/ .*/Authen-SASL-v?(\d[\d.-]+)\.(?:tar(?:\.gz|\.bz2)?|tgz|zip)$ diff -Nru /tmp/MQ70iNNc2v/libauthen-sasl-perl-2.12/.gitignore /tmp/c5NcsEjNyt/libauthen-sasl-perl-2.13/.gitignore --- libauthen-sasl-perl-2.12/.gitignore 2008-07-01 03:57:02.000000000 +0100 +++ libauthen-sasl-perl-2.13/.gitignore 1970-01-01 01:00:00.000000000 +0100 @@ -1,3 +0,0 @@ -Makefile -blib -pm_to_blib diff -Nru /tmp/MQ70iNNc2v/libauthen-sasl-perl-2.12/inc/attributes.pm /tmp/c5NcsEjNyt/libauthen-sasl-perl-2.13/inc/attributes.pm --- libauthen-sasl-perl-2.12/inc/attributes.pm 2008-07-01 03:57:02.000000000 +0100 +++ libauthen-sasl-perl-2.13/inc/attributes.pm 1970-01-01 01:00:00.000000000 +0100 @@ -1,96 +0,0 @@ -#line 1 -package attributes; - -our $VERSION = 0.06; - -@EXPORT_OK = qw(get reftype); -@EXPORT = (); -%EXPORT_TAGS = (ALL => [@EXPORT, @EXPORT_OK]); - -use strict; - -sub croak { - require Carp; - goto &Carp::croak; -} - -sub carp { - require Carp; - goto &Carp::carp; -} - -## forward declaration(s) rather than wrapping the bootstrap call in BEGIN{} -#sub reftype ($) ; -#sub _fetch_attrs ($) ; -#sub _guess_stash ($) ; -#sub _modify_attrs ; -#sub _warn_reserved () ; -# -# The extra trips through newATTRSUB in the interpreter wipe out any savings -# from avoiding the BEGIN block. Just do the bootstrap now. -BEGIN { bootstrap attributes } - -sub import { - @_ > 2 && ref $_[2] or do { - require Exporter; - goto &Exporter::import; - }; - my (undef,$home_stash,$svref,@attrs) = @_; - - my $svtype = uc reftype($svref); - my $pkgmeth; - $pkgmeth = UNIVERSAL::can($home_stash, "MODIFY_${svtype}_ATTRIBUTES") - if defined $home_stash && $home_stash ne ''; - my @badattrs; - if ($pkgmeth) { - my @pkgattrs = _modify_attrs($svref, @attrs); - @badattrs = $pkgmeth->($home_stash, $svref, @attrs); - if (!@badattrs && @pkgattrs) { - return unless _warn_reserved; - @pkgattrs = grep { m/\A[[:lower:]]+(?:\z|\()/ } @pkgattrs; - if (@pkgattrs) { - for my $attr (@pkgattrs) { - $attr =~ s/\(.+\z//s; - } - my $s = ((@pkgattrs == 1) ? '' : 's'); - carp "$svtype package attribute$s " . - "may clash with future reserved word$s: " . - join(' : ' , @pkgattrs); - } - } - } - else { - @badattrs = _modify_attrs($svref, @attrs); - } - if (@badattrs) { - croak "Invalid $svtype attribute" . - (( @badattrs == 1 ) ? '' : 's') . - ": " . - join(' : ', @badattrs); - } -} - -sub get ($) { - @_ == 1 && ref $_[0] or - croak 'Usage: '.__PACKAGE__.'::get $ref'; - my $svref = shift; - my $svtype = uc reftype $svref; - my $stash = _guess_stash $svref; - $stash = caller unless defined $stash; - my $pkgmeth; - $pkgmeth = UNIVERSAL::can($stash, "FETCH_${svtype}_ATTRIBUTES") - if defined $stash && $stash ne ''; - return $pkgmeth ? - (_fetch_attrs($svref), $pkgmeth->($stash, $svref)) : - (_fetch_attrs($svref)) - ; -} - -sub require_version { goto &UNIVERSAL::VERSION } - -1; -__END__ -#The POD goes here - -#line 417 - diff -Nru /tmp/MQ70iNNc2v/libauthen-sasl-perl-2.12/inc/Module/AutoInstall.pm /tmp/c5NcsEjNyt/libauthen-sasl-perl-2.13/inc/Module/AutoInstall.pm --- libauthen-sasl-perl-2.12/inc/Module/AutoInstall.pm 2008-07-01 03:57:02.000000000 +0100 +++ libauthen-sasl-perl-2.13/inc/Module/AutoInstall.pm 1970-01-01 01:00:00.000000000 +0100 @@ -1,768 +0,0 @@ -#line 1 -package Module::AutoInstall; - -use strict; -use Cwd (); -use ExtUtils::MakeMaker (); - -use vars qw{$VERSION}; -BEGIN { - $VERSION = '1.03'; -} - -# special map on pre-defined feature sets -my %FeatureMap = ( - '' => 'Core Features', # XXX: deprecated - '-core' => 'Core Features', -); - -# various lexical flags -my ( @Missing, @Existing, %DisabledTests, $UnderCPAN, $HasCPANPLUS ); -my ( $Config, $CheckOnly, $SkipInstall, $AcceptDefault, $TestOnly ); -my ( $PostambleActions, $PostambleUsed ); - -# See if it's a testing or non-interactive session -_accept_default( $ENV{AUTOMATED_TESTING} or ! -t STDIN ); -_init(); - -sub _accept_default { - $AcceptDefault = shift; -} - -sub missing_modules { - return @Missing; -} - -sub do_install { - __PACKAGE__->install( - [ - $Config - ? ( UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} ) - : () - ], - @Missing, - ); -} - -# initialize various flags, and/or perform install -sub _init { - foreach my $arg ( - @ARGV, - split( - /[\s\t]+/, - $ENV{PERL_AUTOINSTALL} || $ENV{PERL_EXTUTILS_AUTOINSTALL} || '' - ) - ) - { - if ( $arg =~ /^--config=(.*)$/ ) { - $Config = [ split( ',', $1 ) ]; - } - elsif ( $arg =~ /^--installdeps=(.*)$/ ) { - __PACKAGE__->install( $Config, @Missing = split( /,/, $1 ) ); - exit 0; - } - elsif ( $arg =~ /^--default(?:deps)?$/ ) { - $AcceptDefault = 1; - } - elsif ( $arg =~ /^--check(?:deps)?$/ ) { - $CheckOnly = 1; - } - elsif ( $arg =~ /^--skip(?:deps)?$/ ) { - $SkipInstall = 1; - } - elsif ( $arg =~ /^--test(?:only)?$/ ) { - $TestOnly = 1; - } - } -} - -# overrides MakeMaker's prompt() to automatically accept the default choice -sub _prompt { - goto &ExtUtils::MakeMaker::prompt unless $AcceptDefault; - - my ( $prompt, $default ) = @_; - my $y = ( $default =~ /^[Yy]/ ); - - print $prompt, ' [', ( $y ? 'Y' : 'y' ), '/', ( $y ? 'n' : 'N' ), '] '; - print "$default\n"; - return $default; -} - -# the workhorse -sub import { - my $class = shift; - my @args = @_ or return; - my $core_all; - - print "*** $class version " . $class->VERSION . "\n"; - print "*** Checking for Perl dependencies...\n"; - - my $cwd = Cwd::cwd(); - - $Config = []; - - my $maxlen = length( - ( - sort { length($b) <=> length($a) } - grep { /^[^\-]/ } - map { - ref($_) - ? ( ( ref($_) eq 'HASH' ) ? keys(%$_) : @{$_} ) - : '' - } - map { +{@args}->{$_} } - grep { /^[^\-]/ or /^-core$/i } keys %{ +{@args} } - )[0] - ); - - while ( my ( $feature, $modules ) = splice( @args, 0, 2 ) ) { - my ( @required, @tests, @skiptests ); - my $default = 1; - my $conflict = 0; - - if ( $feature =~ m/^-(\w+)$/ ) { - my $option = lc($1); - - # check for a newer version of myself - _update_to( $modules, @_ ) and return if $option eq 'version'; - - # sets CPAN configuration options - $Config = $modules if $option eq 'config'; - - # promote every features to core status - $core_all = ( $modules =~ /^all$/i ) and next - if $option eq 'core'; - - next unless $option eq 'core'; - } - - print "[" . ( $FeatureMap{ lc($feature) } || $feature ) . "]\n"; - - $modules = [ %{$modules} ] if UNIVERSAL::isa( $modules, 'HASH' ); - - unshift @$modules, -default => &{ shift(@$modules) } - if ( ref( $modules->[0] ) eq 'CODE' ); # XXX: bugward combatability - - while ( my ( $mod, $arg ) = splice( @$modules, 0, 2 ) ) { - if ( $mod =~ m/^-(\w+)$/ ) { - my $option = lc($1); - - $default = $arg if ( $option eq 'default' ); - $conflict = $arg if ( $option eq 'conflict' ); - @tests = @{$arg} if ( $option eq 'tests' ); - @skiptests = @{$arg} if ( $option eq 'skiptests' ); - - next; - } - - printf( "- %-${maxlen}s ...", $mod ); - - if ( $arg and $arg =~ /^\D/ ) { - unshift @$modules, $arg; - $arg = 0; - } - - # XXX: check for conflicts and uninstalls(!) them. - if ( - defined( my $cur = _version_check( _load($mod), $arg ||= 0 ) ) ) - { - print "loaded. ($cur" . ( $arg ? " >= $arg" : '' ) . ")\n"; - push @Existing, $mod => $arg; - $DisabledTests{$_} = 1 for map { glob($_) } @skiptests; - } - else { - print "missing." . ( $arg ? " (would need $arg)" : '' ) . "\n"; - push @required, $mod => $arg; - } - } - - next unless @required; - - my $mandatory = ( $feature eq '-core' or $core_all ); - - if ( - !$SkipInstall - and ( - $CheckOnly - or _prompt( - qq{==> Auto-install the } - . ( @required / 2 ) - . ( $mandatory ? ' mandatory' : ' optional' ) - . qq{ module(s) from CPAN?}, - $default ? 'y' : 'n', - ) =~ /^[Yy]/ - ) - ) - { - push( @Missing, @required ); - $DisabledTests{$_} = 1 for map { glob($_) } @skiptests; - } - - elsif ( !$SkipInstall - and $default - and $mandatory - and - _prompt( qq{==> The module(s) are mandatory! Really skip?}, 'n', ) - =~ /^[Nn]/ ) - { - push( @Missing, @required ); - $DisabledTests{$_} = 1 for map { glob($_) } @skiptests; - } - - else { - $DisabledTests{$_} = 1 for map { glob($_) } @tests; - } - } - - $UnderCPAN = _check_lock(); # check for $UnderCPAN - - if ( @Missing and not( $CheckOnly or $UnderCPAN ) ) { - require Config; - print -"*** Dependencies will be installed the next time you type '$Config::Config{make}'.\n"; - - # make an educated guess of whether we'll need root permission. - print " (You may need to do that as the 'root' user.)\n" - if eval '$>'; - } - print "*** $class configuration finished.\n"; - - chdir $cwd; - - # import to main:: - no strict 'refs'; - *{'main::WriteMakefile'} = \&Write if caller(0) eq 'main'; -} - -# Check to see if we are currently running under CPAN.pm and/or CPANPLUS; -# if we are, then we simply let it taking care of our dependencies -sub _check_lock { - return unless @Missing; - - if ($ENV{PERL5_CPANPLUS_IS_RUNNING}) { - print <<'END_MESSAGE'; - -*** Since we're running under CPANPLUS, I'll just let it take care - of the dependency's installation later. -END_MESSAGE - return 1; - } - - _load_cpan(); - - # Find the CPAN lock-file - my $lock = MM->catfile( $CPAN::Config->{cpan_home}, ".lock" ); - return unless -f $lock; - - # Check the lock - local *LOCK; - return unless open(LOCK, $lock); - - if ( - ( $^O eq 'MSWin32' ? _under_cpan() : == getppid() ) - and ( $CPAN::Config->{prerequisites_policy} || '' ) ne 'ignore' - ) { - print <<'END_MESSAGE'; - -*** Since we're running under CPAN, I'll just let it take care - of the dependency's installation later. -END_MESSAGE - return 1; - } - - close LOCK; - return; -} - -sub install { - my $class = shift; - - my $i; # used below to strip leading '-' from config keys - my @config = ( map { s/^-// if ++$i; $_ } @{ +shift } ); - - my ( @modules, @installed ); - while ( my ( $pkg, $ver ) = splice( @_, 0, 2 ) ) { - - # grep out those already installed - if ( defined( _version_check( _load($pkg), $ver ) ) ) { - push @installed, $pkg; - } - else { - push @modules, $pkg, $ver; - } - } - - return @installed unless @modules; # nothing to do - return @installed if _check_lock(); # defer to the CPAN shell - - print "*** Installing dependencies...\n"; - - return unless _connected_to('cpan.org'); - - my %args = @config; - my %failed; - local *FAILED; - if ( $args{do_once} and open( FAILED, '.#autoinstall.failed' ) ) { - while () { chomp; $failed{$_}++ } - close FAILED; - - my @newmod; - while ( my ( $k, $v ) = splice( @modules, 0, 2 ) ) { - push @newmod, ( $k => $v ) unless $failed{$k}; - } - @modules = @newmod; - } - - if ( _has_cpanplus() ) { - _install_cpanplus( \@modules, \@config ); - } else { - _install_cpan( \@modules, \@config ); - } - - print "*** $class installation finished.\n"; - - # see if we have successfully installed them - while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) { - if ( defined( _version_check( _load($pkg), $ver ) ) ) { - push @installed, $pkg; - } - elsif ( $args{do_once} and open( FAILED, '>> .#autoinstall.failed' ) ) { - print FAILED "$pkg\n"; - } - } - - close FAILED if $args{do_once}; - - return @installed; -} - -sub _install_cpanplus { - my @modules = @{ +shift }; - my @config = _cpanplus_config( @{ +shift } ); - my $installed = 0; - - require CPANPLUS::Backend; - my $cp = CPANPLUS::Backend->new; - my $conf = $cp->configure_object; - - return unless $conf->can('conf') # 0.05x+ with "sudo" support - or _can_write($conf->_get_build('base')); # 0.04x - - # if we're root, set UNINST=1 to avoid trouble unless user asked for it. - my $makeflags = $conf->get_conf('makeflags') || ''; - if ( UNIVERSAL::isa( $makeflags, 'HASH' ) ) { - # 0.03+ uses a hashref here - $makeflags->{UNINST} = 1 unless exists $makeflags->{UNINST}; - - } else { - # 0.02 and below uses a scalar - $makeflags = join( ' ', split( ' ', $makeflags ), 'UNINST=1' ) - if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } ); - - } - $conf->set_conf( makeflags => $makeflags ); - $conf->set_conf( prereqs => 1 ); - - - - while ( my ( $key, $val ) = splice( @config, 0, 2 ) ) { - $conf->set_conf( $key, $val ); - } - - my $modtree = $cp->module_tree; - while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) { - print "*** Installing $pkg...\n"; - - MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall; - - my $success; - my $obj = $modtree->{$pkg}; - - if ( $obj and defined( _version_check( $obj->{version}, $ver ) ) ) { - my $pathname = $pkg; - $pathname =~ s/::/\\W/; - - foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) { - delete $INC{$inc}; - } - - my $rv = $cp->install( modules => [ $obj->{module} ] ); - - if ( $rv and ( $rv->{ $obj->{module} } or $rv->{ok} ) ) { - print "*** $pkg successfully installed.\n"; - $success = 1; - } else { - print "*** $pkg installation cancelled.\n"; - $success = 0; - } - - $installed += $success; - } else { - print << "."; -*** Could not find a version $ver or above for $pkg; skipping. -. - } - - MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall; - } - - return $installed; -} - -sub _cpanplus_config { - my @config = (); - while ( @_ ) { - my ($key, $value) = (shift(), shift()); - if ( $key eq 'prerequisites_policy' ) { - if ( $value eq 'follow' ) { - $value = CPANPLUS::Internals::Constants::PREREQ_INSTALL(); - } elsif ( $value eq 'ask' ) { - $value = CPANPLUS::Internals::Constants::PREREQ_ASK(); - } elsif ( $value eq 'ignore' ) { - $value = CPANPLUS::Internals::Constants::PREREQ_IGNORE(); - } else { - die "*** Cannot convert option $key = '$value' to CPANPLUS version.\n"; - } - } else { - die "*** Cannot convert option $key to CPANPLUS version.\n"; - } - } - return @config; -} - -sub _install_cpan { - my @modules = @{ +shift }; - my @config = @{ +shift }; - my $installed = 0; - my %args; - - _load_cpan(); - require Config; - - if (CPAN->VERSION < 1.80) { - # no "sudo" support, probe for writableness - return unless _can_write( MM->catfile( $CPAN::Config->{cpan_home}, 'sources' ) ) - and _can_write( $Config::Config{sitelib} ); - } - - # if we're root, set UNINST=1 to avoid trouble unless user asked for it. - my $makeflags = $CPAN::Config->{make_install_arg} || ''; - $CPAN::Config->{make_install_arg} = - join( ' ', split( ' ', $makeflags ), 'UNINST=1' ) - if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } ); - - # don't show start-up info - $CPAN::Config->{inhibit_startup_message} = 1; - - # set additional options - while ( my ( $opt, $arg ) = splice( @config, 0, 2 ) ) { - ( $args{$opt} = $arg, next ) - if $opt =~ /^force$/; # pseudo-option - $CPAN::Config->{$opt} = $arg; - } - - local $CPAN::Config->{prerequisites_policy} = 'follow'; - - while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) { - MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall; - - print "*** Installing $pkg...\n"; - - my $obj = CPAN::Shell->expand( Module => $pkg ); - my $success = 0; - - if ( $obj and defined( _version_check( $obj->cpan_version, $ver ) ) ) { - my $pathname = $pkg; - $pathname =~ s/::/\\W/; - - foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) { - delete $INC{$inc}; - } - - my $rv = $args{force} ? CPAN::Shell->force( install => $pkg ) - : CPAN::Shell->install($pkg); - $rv ||= eval { - $CPAN::META->instance( 'CPAN::Distribution', $obj->cpan_file, ) - ->{install} - if $CPAN::META; - }; - - if ( $rv eq 'YES' ) { - print "*** $pkg successfully installed.\n"; - $success = 1; - } - else { - print "*** $pkg installation failed.\n"; - $success = 0; - } - - $installed += $success; - } - else { - print << "."; -*** Could not find a version $ver or above for $pkg; skipping. -. - } - - MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall; - } - - return $installed; -} - -sub _has_cpanplus { - return ( - $HasCPANPLUS = ( - $INC{'CPANPLUS/Config.pm'} - or _load('CPANPLUS::Shell::Default') - ) - ); -} - -# make guesses on whether we're under the CPAN installation directory -sub _under_cpan { - require Cwd; - require File::Spec; - - my $cwd = File::Spec->canonpath( Cwd::cwd() ); - my $cpan = File::Spec->canonpath( $CPAN::Config->{cpan_home} ); - - return ( index( $cwd, $cpan ) > -1 ); -} - -sub _update_to { - my $class = __PACKAGE__; - my $ver = shift; - - return - if defined( _version_check( _load($class), $ver ) ); # no need to upgrade - - if ( - _prompt( "==> A newer version of $class ($ver) is required. Install?", - 'y' ) =~ /^[Nn]/ - ) - { - die "*** Please install $class $ver manually.\n"; - } - - print << "."; -*** Trying to fetch it from CPAN... -. - - # install ourselves - _load($class) and return $class->import(@_) - if $class->install( [], $class, $ver ); - - print << '.'; exit 1; - -*** Cannot bootstrap myself. :-( Installation terminated. -. -} - -# check if we're connected to some host, using inet_aton -sub _connected_to { - my $site = shift; - - return ( - ( _load('Socket') and Socket::inet_aton($site) ) or _prompt( - qq( -*** Your host cannot resolve the domain name '$site', which - probably means the Internet connections are unavailable. -==> Should we try to install the required module(s) anyway?), 'n' - ) =~ /^[Yy]/ - ); -} - -# check if a directory is writable; may create it on demand -sub _can_write { - my $path = shift; - mkdir( $path, 0755 ) unless -e $path; - - return 1 if -w $path; - - print << "."; -*** You are not allowed to write to the directory '$path'; - the installation may fail due to insufficient permissions. -. - - if ( - eval '$>' and lc(`sudo -V`) =~ /version/ and _prompt( - qq( -==> Should we try to re-execute the autoinstall process with 'sudo'?), - ((-t STDIN) ? 'y' : 'n') - ) =~ /^[Yy]/ - ) - { - - # try to bootstrap ourselves from sudo - print << "."; -*** Trying to re-execute the autoinstall process with 'sudo'... -. - my $missing = join( ',', @Missing ); - my $config = join( ',', - UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} ) - if $Config; - - return - unless system( 'sudo', $^X, $0, "--config=$config", - "--installdeps=$missing" ); - - print << "."; -*** The 'sudo' command exited with error! Resuming... -. - } - - return _prompt( - qq( -==> Should we try to install the required module(s) anyway?), 'n' - ) =~ /^[Yy]/; -} - -# load a module and return the version it reports -sub _load { - my $mod = pop; # class/instance doesn't matter - my $file = $mod; - - $file =~ s|::|/|g; - $file .= '.pm'; - - local $@; - return eval { require $file; $mod->VERSION } || ( $@ ? undef: 0 ); -} - -# Load CPAN.pm and it's configuration -sub _load_cpan { - return if $CPAN::VERSION; - require CPAN; - if ( $CPAN::HandleConfig::VERSION ) { - # Newer versions of CPAN have a HandleConfig module - CPAN::HandleConfig->load; - } else { - # Older versions had the load method in Config directly - CPAN::Config->load; - } -} - -# compare two versions, either use Sort::Versions or plain comparison -sub _version_check { - my ( $cur, $min ) = @_; - return unless defined $cur; - - $cur =~ s/\s+$//; - - # check for version numbers that are not in decimal format - if ( ref($cur) or ref($min) or $cur =~ /v|\..*\./ or $min =~ /v|\..*\./ ) { - if ( ( $version::VERSION or defined( _load('version') )) and - version->can('new') - ) { - - # use version.pm if it is installed. - return ( - ( version->new($cur) >= version->new($min) ) ? $cur : undef ); - } - elsif ( $Sort::Versions::VERSION or defined( _load('Sort::Versions') ) ) - { - - # use Sort::Versions as the sorting algorithm for a.b.c versions - return ( ( Sort::Versions::versioncmp( $cur, $min ) != -1 ) - ? $cur - : undef ); - } - - warn "Cannot reliably compare non-decimal formatted versions.\n" - . "Please install version.pm or Sort::Versions.\n"; - } - - # plain comparison - local $^W = 0; # shuts off 'not numeric' bugs - return ( $cur >= $min ? $cur : undef ); -} - -# nothing; this usage is deprecated. -sub main::PREREQ_PM { return {}; } - -sub _make_args { - my %args = @_; - - $args{PREREQ_PM} = { %{ $args{PREREQ_PM} || {} }, @Existing, @Missing } - if $UnderCPAN or $TestOnly; - - if ( $args{EXE_FILES} and -e 'MANIFEST' ) { - require ExtUtils::Manifest; - my $manifest = ExtUtils::Manifest::maniread('MANIFEST'); - - $args{EXE_FILES} = - [ grep { exists $manifest->{$_} } @{ $args{EXE_FILES} } ]; - } - - $args{test}{TESTS} ||= 't/*.t'; - $args{test}{TESTS} = join( ' ', - grep { !exists( $DisabledTests{$_} ) } - map { glob($_) } split( /\s+/, $args{test}{TESTS} ) ); - - my $missing = join( ',', @Missing ); - my $config = - join( ',', UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} ) - if $Config; - - $PostambleActions = ( - $missing - ? "\$(PERL) $0 --config=$config --installdeps=$missing" - : "\$(NOECHO) \$(NOOP)" - ); - - return %args; -} - -# a wrapper to ExtUtils::MakeMaker::WriteMakefile -sub Write { - require Carp; - Carp::croak "WriteMakefile: Need even number of args" if @_ % 2; - - if ($CheckOnly) { - print << "."; -*** Makefile not written in check-only mode. -. - return; - } - - my %args = _make_args(@_); - - no strict 'refs'; - - $PostambleUsed = 0; - local *MY::postamble = \&postamble unless defined &MY::postamble; - ExtUtils::MakeMaker::WriteMakefile(%args); - - print << "." unless $PostambleUsed; -*** WARNING: Makefile written with customized MY::postamble() without - including contents from Module::AutoInstall::postamble() -- - auto installation features disabled. Please contact the author. -. - - return 1; -} - -sub postamble { - $PostambleUsed = 1; - - return << "."; - -config :: installdeps -\t\$(NOECHO) \$(NOOP) - -checkdeps :: -\t\$(PERL) $0 --checkdeps - -installdeps :: -\t$PostambleActions - -. - -} - -1; - -__END__ - -#line 1003 diff -Nru /tmp/MQ70iNNc2v/libauthen-sasl-perl-2.12/inc/Module/Install/AutoInstall.pm /tmp/c5NcsEjNyt/libauthen-sasl-perl-2.13/inc/Module/Install/AutoInstall.pm --- libauthen-sasl-perl-2.12/inc/Module/Install/AutoInstall.pm 2008-07-01 03:57:02.000000000 +0100 +++ libauthen-sasl-perl-2.13/inc/Module/Install/AutoInstall.pm 1970-01-01 01:00:00.000000000 +0100 @@ -1,61 +0,0 @@ -#line 1 -package Module::Install::AutoInstall; - -use strict; -use Module::Install::Base; - -use vars qw{$VERSION $ISCORE @ISA}; -BEGIN { - $VERSION = '0.75'; - $ISCORE = 1; - @ISA = qw{Module::Install::Base}; -} - -sub AutoInstall { $_[0] } - -sub run { - my $self = shift; - $self->auto_install_now(@_); -} - -sub write { - my $self = shift; - $self->auto_install(@_); -} - -sub auto_install { - my $self = shift; - return if $self->{done}++; - - # Flatten array of arrays into a single array - my @core = map @$_, map @$_, grep ref, - $self->build_requires, $self->requires; - - my @config = @_; - - # We'll need Module::AutoInstall - $self->include('Module::AutoInstall'); - require Module::AutoInstall; - - Module::AutoInstall->import( - (@config ? (-config => \@config) : ()), - (@core ? (-core => \@core) : ()), - $self->features, - ); - - $self->makemaker_args( Module::AutoInstall::_make_args() ); - - my $class = ref($self); - $self->postamble( - "# --- $class section:\n" . - Module::AutoInstall::postamble() - ); -} - -sub auto_install_now { - my $self = shift; - $self->auto_install(@_); - Module::AutoInstall::do_install(); -} - -1; diff -Nru /tmp/MQ70iNNc2v/libauthen-sasl-perl-2.12/inc/Module/Install/Base.pm /tmp/c5NcsEjNyt/libauthen-sasl-perl-2.13/inc/Module/Install/Base.pm --- libauthen-sasl-perl-2.12/inc/Module/Install/Base.pm 2008-07-01 03:57:02.000000000 +0100 +++ libauthen-sasl-perl-2.13/inc/Module/Install/Base.pm 2009-09-24 23:35:07.000000000 +0100 @@ -1,7 +1,11 @@ #line 1 package Module::Install::Base; -$VERSION = '0.75'; +use strict 'vars'; +use vars qw{$VERSION}; +BEGIN { + $VERSION = '0.91'; +} # Suspend handler for "redefined" warnings BEGIN { @@ -9,52 +13,56 @@ $SIG{__WARN__} = sub { $w }; } -### This is the ONLY module that shouldn't have strict on -# use strict; - -#line 41 +#line 42 sub new { - my ($class, %args) = @_; - - foreach my $method ( qw(call load) ) { - *{"$class\::$method"} = sub { - shift()->_top->$method(@_); - } unless defined &{"$class\::$method"}; - } - - bless( \%args, $class ); + my $class = shift; + unless ( defined &{"${class}::call"} ) { + *{"${class}::call"} = sub { shift->_top->call(@_) }; + } + unless ( defined &{"${class}::load"} ) { + *{"${class}::load"} = sub { shift->_top->load(@_) }; + } + bless { @_ }, $class; } #line 61 sub AUTOLOAD { - my $self = shift; - local $@; - my $autoload = eval { $self->_top->autoload } or return; - goto &$autoload; + local $@; + my $func = eval { shift->_top->autoload } or return; + goto &$func; } -#line 76 +#line 75 -sub _top { $_[0]->{_top} } +sub _top { + $_[0]->{_top}; +} -#line 89 +#line 90 sub admin { - $_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new; + $_[0]->_top->{admin} + or + Module::Install::Base::FakeAdmin->new; } +#line 106 + sub is_admin { - $_[0]->admin->VERSION; + $_[0]->admin->VERSION; } sub DESTROY {} package Module::Install::Base::FakeAdmin; -my $Fake; -sub new { $Fake ||= bless(\@_, $_[0]) } +my $fake; + +sub new { + $fake ||= bless(\@_, $_[0]); +} sub AUTOLOAD {} @@ -67,4 +75,4 @@ 1; -#line 138 +#line 154 diff -Nru /tmp/MQ70iNNc2v/libauthen-sasl-perl-2.12/inc/Module/Install/Can.pm /tmp/c5NcsEjNyt/libauthen-sasl-perl-2.13/inc/Module/Install/Can.pm --- libauthen-sasl-perl-2.12/inc/Module/Install/Can.pm 2008-07-01 03:57:02.000000000 +0100 +++ libauthen-sasl-perl-2.13/inc/Module/Install/Can.pm 2009-09-24 23:35:07.000000000 +0100 @@ -2,18 +2,16 @@ package Module::Install::Can; use strict; -use Module::Install::Base; -use Config (); -### This adds a 5.005 Perl version dependency. -### This is a bug and will be fixed. -use File::Spec (); -use ExtUtils::MakeMaker (); +use Config (); +use File::Spec (); +use ExtUtils::MakeMaker (); +use Module::Install::Base (); -use vars qw{$VERSION $ISCORE @ISA}; +use vars qw{$VERSION @ISA $ISCORE}; BEGIN { - $VERSION = '0.75'; + $VERSION = '0.91'; + @ISA = 'Module::Install::Base'; $ISCORE = 1; - @ISA = qw{Module::Install::Base}; } # check if we can load some module @@ -39,6 +37,7 @@ return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd)); for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') { + next if $dir eq ''; my $abs = File::Spec->catfile($dir, $_[1]); return $abs if (-x $abs or $abs = MM->maybe_command($abs)); } @@ -79,4 +78,4 @@ __END__ -#line 157 +#line 156 diff -Nru /tmp/MQ70iNNc2v/libauthen-sasl-perl-2.12/inc/Module/Install/Fetch.pm /tmp/c5NcsEjNyt/libauthen-sasl-perl-2.13/inc/Module/Install/Fetch.pm --- libauthen-sasl-perl-2.12/inc/Module/Install/Fetch.pm 2008-07-01 03:57:02.000000000 +0100 +++ libauthen-sasl-perl-2.13/inc/Module/Install/Fetch.pm 2009-09-24 23:35:07.000000000 +0100 @@ -2,24 +2,24 @@ package Module::Install::Fetch; use strict; -use Module::Install::Base; +use Module::Install::Base (); -use vars qw{$VERSION $ISCORE @ISA}; +use vars qw{$VERSION @ISA $ISCORE}; BEGIN { - $VERSION = '0.75'; + $VERSION = '0.91'; + @ISA = 'Module::Install::Base'; $ISCORE = 1; - @ISA = qw{Module::Install::Base}; } sub get_file { my ($self, %args) = @_; - my ($scheme, $host, $path, $file) = + my ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) { $args{url} = $args{ftp_url} or (warn("LWP support unavailable!\n"), return); - ($scheme, $host, $path, $file) = + ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; } diff -Nru /tmp/MQ70iNNc2v/libauthen-sasl-perl-2.12/inc/Module/Install/Include.pm /tmp/c5NcsEjNyt/libauthen-sasl-perl-2.13/inc/Module/Install/Include.pm --- libauthen-sasl-perl-2.12/inc/Module/Install/Include.pm 2008-07-01 03:57:02.000000000 +0100 +++ libauthen-sasl-perl-2.13/inc/Module/Install/Include.pm 1970-01-01 01:00:00.000000000 +0100 @@ -1,34 +0,0 @@ -#line 1 -package Module::Install::Include; - -use strict; -use Module::Install::Base; - -use vars qw{$VERSION $ISCORE @ISA}; -BEGIN { - $VERSION = '0.75'; - $ISCORE = 1; - @ISA = qw{Module::Install::Base}; -} - -sub include { - shift()->admin->include(@_); -} - -sub include_deps { - shift()->admin->include_deps(@_); -} - -sub auto_include { - shift()->admin->auto_include(@_); -} - -sub auto_include_deps { - shift()->admin->auto_include_deps(@_); -} - -sub auto_include_dependent_dists { - shift()->admin->auto_include_dependent_dists(@_); -} - -1; diff -Nru /tmp/MQ70iNNc2v/libauthen-sasl-perl-2.12/inc/Module/Install/Makefile.pm /tmp/c5NcsEjNyt/libauthen-sasl-perl-2.13/inc/Module/Install/Makefile.pm --- libauthen-sasl-perl-2.12/inc/Module/Install/Makefile.pm 2008-07-01 03:57:02.000000000 +0100 +++ libauthen-sasl-perl-2.13/inc/Module/Install/Makefile.pm 2009-09-24 23:35:07.000000000 +0100 @@ -2,14 +2,14 @@ package Module::Install::Makefile; use strict 'vars'; -use Module::Install::Base; -use ExtUtils::MakeMaker (); +use ExtUtils::MakeMaker (); +use Module::Install::Base (); -use vars qw{$VERSION $ISCORE @ISA}; +use vars qw{$VERSION @ISA $ISCORE}; BEGIN { - $VERSION = '0.75'; + $VERSION = '0.91'; + @ISA = 'Module::Install::Base'; $ISCORE = 1; - @ISA = qw{Module::Install::Base}; } sub Makefile { $_[0] } @@ -36,9 +36,9 @@ sub makemaker_args { my $self = shift; - my $args = ($self->{makemaker_args} ||= {}); - %$args = ( %$args, @_ ) if @_; - $args; + my $args = ( $self->{makemaker_args} ||= {} ); + %$args = ( %$args, @_ ); + return $args; } # For mm args that take multiple space-seperated args, @@ -64,7 +64,7 @@ my $self = shift; my $clean = $self->makemaker_args->{clean} ||= {}; %$clean = ( - %$clean, + %$clean, FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_), ); } @@ -73,7 +73,7 @@ my $self = shift; my $realclean = $self->makemaker_args->{realclean} ||= {}; %$realclean = ( - %$realclean, + %$realclean, FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_), ); } @@ -114,11 +114,32 @@ my $self = shift; die "&Makefile->write() takes no arguments\n" if @_; - # Make sure we have a new enough + # Check the current Perl version + my $perl_version = $self->perl_version; + if ( $perl_version ) { + eval "use $perl_version; 1" + or die "ERROR: perl: Version $] is installed, " + . "but we need version >= $perl_version"; + } + + # Make sure we have a new enough MakeMaker require ExtUtils::MakeMaker; - $self->configure_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION ); - # Generate the + if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) { + # MakeMaker can complain about module versions that include + # an underscore, even though its own version may contain one! + # Hence the funny regexp to get rid of it. See RT #35800 + # for details. + $self->build_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/ ); + $self->configure_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/ ); + } else { + # Allow legacy-compatibility with 5.005 by depending on the + # most recent EU:MM that supported 5.005. + $self->build_requires( 'ExtUtils::MakeMaker' => 6.42 ); + $self->configure_requires( 'ExtUtils::MakeMaker' => 6.42 ); + } + + # Generate the MakeMaker params my $args = $self->makemaker_args; $args->{DISTNAME} = $self->name; $args->{NAME} = $self->module_name || $self->name; @@ -127,7 +148,7 @@ if ( $self->tests ) { $args->{test} = { TESTS => $self->tests }; } - if ($] >= 5.005) { + if ( $] >= 5.005 ) { $args->{ABSTRACT} = $self->abstract; $args->{AUTHOR} = $self->author; } @@ -141,7 +162,7 @@ delete $args->{SIGN}; } - # merge both kinds of requires into prereq_pm + # Merge both kinds of requires into prereq_pm my $prereq = ($args->{PREREQ_PM} ||= {}); %$prereq = ( %$prereq, map { @$_ } @@ -175,7 +196,9 @@ my $user_preop = delete $args{dist}->{PREOP}; if (my $preop = $self->admin->preop($user_preop)) { - $args{dist} = $preop; + foreach my $key ( keys %$preop ) { + $args{dist}->{$key} = $preop->{$key}; + } } my $mm = ExtUtils::MakeMaker::WriteMakefile(%args); @@ -188,7 +211,7 @@ my $top_class = ref($self->_top) || ''; my $top_version = $self->_top->VERSION || ''; - my $preamble = $self->preamble + my $preamble = $self->preamble ? "# Preamble by $top_class $top_version\n" . $self->preamble : ''; @@ -242,4 +265,4 @@ __END__ -#line 371 +#line 394 diff -Nru /tmp/MQ70iNNc2v/libauthen-sasl-perl-2.12/inc/Module/Install/Metadata.pm /tmp/c5NcsEjNyt/libauthen-sasl-perl-2.13/inc/Module/Install/Metadata.pm --- libauthen-sasl-perl-2.12/inc/Module/Install/Metadata.pm 2008-07-01 03:57:02.000000000 +0100 +++ libauthen-sasl-perl-2.13/inc/Module/Install/Metadata.pm 2009-09-24 23:35:07.000000000 +0100 @@ -2,24 +2,26 @@ package Module::Install::Metadata; use strict 'vars'; -use Module::Install::Base; +use Module::Install::Base (); -use vars qw{$VERSION $ISCORE @ISA}; +use vars qw{$VERSION @ISA $ISCORE}; BEGIN { - $VERSION = '0.75'; + $VERSION = '0.91'; + @ISA = 'Module::Install::Base'; $ISCORE = 1; - @ISA = qw{Module::Install::Base}; } +my @boolean_keys = qw{ + sign +}; + my @scalar_keys = qw{ name module_name abstract author version - license distribution_type - perl_version tests installdirs }; @@ -33,123 +35,199 @@ resources }; -sub Meta { shift } -sub Meta_ScalarKeys { @scalar_keys } -sub Meta_TupleKeys { @tuple_keys } +my @resource_keys = qw{ + homepage + bugtracker + repository +}; + +my @array_keys = qw{ + keywords +}; + +sub Meta { shift } +sub Meta_BooleanKeys { @boolean_keys } +sub Meta_ScalarKeys { @scalar_keys } +sub Meta_TupleKeys { @tuple_keys } +sub Meta_ResourceKeys { @resource_keys } +sub Meta_ArrayKeys { @array_keys } -foreach my $key (@scalar_keys) { +foreach my $key ( @boolean_keys ) { *$key = sub { my $self = shift; - return $self->{values}{$key} if defined wantarray and !@_; - $self->{values}{$key} = shift; + if ( defined wantarray and not @_ ) { + return $self->{values}->{$key}; + } + $self->{values}->{$key} = ( @_ ? $_[0] : 1 ); return $self; }; } -sub requires { - my $self = shift; - while ( @_ ) { - my $module = shift or last; - my $version = shift || 0; - push @{ $self->{values}->{requires} }, [ $module, $version ]; - } - $self->{values}{requires}; -} - -sub build_requires { - my $self = shift; - while ( @_ ) { - my $module = shift or last; - my $version = shift || 0; - push @{ $self->{values}->{build_requires} }, [ $module, $version ]; - } - $self->{values}{build_requires}; +foreach my $key ( @scalar_keys ) { + *$key = sub { + my $self = shift; + return $self->{values}->{$key} if defined wantarray and !@_; + $self->{values}->{$key} = shift; + return $self; + }; } -sub configure_requires { - my $self = shift; - while ( @_ ) { - my $module = shift or last; - my $version = shift || 0; - push @{ $self->{values}->{configure_requires} }, [ $module, $version ]; - } - $self->{values}->{configure_requires}; +foreach my $key ( @array_keys ) { + *$key = sub { + my $self = shift; + return $self->{values}->{$key} if defined wantarray and !@_; + $self->{values}->{$key} ||= []; + push @{$self->{values}->{$key}}, @_; + return $self; + }; } -sub recommends { - my $self = shift; - while ( @_ ) { - my $module = shift or last; - my $version = shift || 0; - push @{ $self->{values}->{recommends} }, [ $module, $version ]; - } - $self->{values}->{recommends}; +foreach my $key ( @resource_keys ) { + *$key = sub { + my $self = shift; + unless ( @_ ) { + return () unless $self->{values}->{resources}; + return map { $_->[1] } + grep { $_->[0] eq $key } + @{ $self->{values}->{resources} }; + } + return $self->{values}->{resources}->{$key} unless @_; + my $uri = shift or die( + "Did not provide a value to $key()" + ); + $self->resources( $key => $uri ); + return 1; + }; } -sub bundles { - my $self = shift; - while ( @_ ) { - my $module = shift or last; - my $version = shift || 0; - push @{ $self->{values}->{bundles} }, [ $module, $version ]; - } - $self->{values}->{bundles}; +foreach my $key ( grep { $_ ne "resources" } @tuple_keys) { + *$key = sub { + my $self = shift; + return $self->{values}->{$key} unless @_; + my @added; + while ( @_ ) { + my $module = shift or last; + my $version = shift || 0; + push @added, [ $module, $version ]; + } + push @{ $self->{values}->{$key} }, @added; + return map {@$_} @added; + }; } # Resource handling +my %lc_resource = map { $_ => 1 } qw{ + homepage + license + bugtracker + repository +}; + sub resources { my $self = shift; while ( @_ ) { - my $resource = shift or last; - my $value = shift or next; - push @{ $self->{values}->{resources} }, [ $resource, $value ]; + my $name = shift or last; + my $value = shift or next; + if ( $name eq lc $name and ! $lc_resource{$name} ) { + die("Unsupported reserved lowercase resource '$name'"); + } + $self->{values}->{resources} ||= []; + push @{ $self->{values}->{resources} }, [ $name, $value ]; } $self->{values}->{resources}; } -sub repository { - my $self = shift; - $self->resources( repository => shift ); - return 1; -} - # Aliases for build_requires that will have alternative # meanings in some future version of META.yml. -sub test_requires { shift->build_requires(@_) } -sub install_requires { shift->build_requires(@_) } +sub test_requires { shift->build_requires(@_) } +sub install_requires { shift->build_requires(@_) } # Aliases for installdirs options -sub install_as_core { $_[0]->installdirs('perl') } -sub install_as_cpan { $_[0]->installdirs('site') } -sub install_as_site { $_[0]->installdirs('site') } -sub install_as_vendor { $_[0]->installdirs('vendor') } - -sub sign { - my $self = shift; - return $self->{'values'}{'sign'} if defined wantarray and ! @_; - $self->{'values'}{'sign'} = ( @_ ? $_[0] : 1 ); - return $self; -} +sub install_as_core { $_[0]->installdirs('perl') } +sub install_as_cpan { $_[0]->installdirs('site') } +sub install_as_site { $_[0]->installdirs('site') } +sub install_as_vendor { $_[0]->installdirs('vendor') } sub dynamic_config { my $self = shift; unless ( @_ ) { - warn "You MUST provide an explicit true/false value to dynamic_config, skipping\n"; + warn "You MUST provide an explicit true/false value to dynamic_config\n"; return $self; } - $self->{values}{dynamic_config} = $_[0] ? 1 : 0; - return $self; + $self->{values}->{dynamic_config} = $_[0] ? 1 : 0; + return 1; +} + +sub perl_version { + my $self = shift; + return $self->{values}->{perl_version} unless @_; + my $version = shift or die( + "Did not provide a value to perl_version()" + ); + + # Normalize the version + $version = $self->_perl_version($version); + + # We don't support the reall old versions + unless ( $version >= 5.005 ) { + die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n"; + } + + $self->{values}->{perl_version} = $version; +} + +#Stolen from M::B +my %license_urls = ( + perl => 'http://dev.perl.org/licenses/', + apache => 'http://apache.org/licenses/LICENSE-2.0', + artistic => 'http://opensource.org/licenses/artistic-license.php', + artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php', + lgpl => 'http://opensource.org/licenses/lgpl-license.php', + lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php', + lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html', + bsd => 'http://opensource.org/licenses/bsd-license.php', + gpl => 'http://opensource.org/licenses/gpl-license.php', + gpl2 => 'http://opensource.org/licenses/gpl-2.0.php', + gpl3 => 'http://opensource.org/licenses/gpl-3.0.html', + mit => 'http://opensource.org/licenses/mit-license.php', + mozilla => 'http://opensource.org/licenses/mozilla1.1.php', + open_source => undef, + unrestricted => undef, + restrictive => undef, + unknown => undef, +); + +sub license { + my $self = shift; + return $self->{values}->{license} unless @_; + my $license = shift or die( + 'Did not provide a value to license()' + ); + $self->{values}->{license} = $license; + + # Automatically fill in license URLs + if ( $license_urls{$license} ) { + $self->resources( license => $license_urls{$license} ); + } + + return 1; } sub all_from { my ( $self, $file ) = @_; unless ( defined($file) ) { - my $name = $self->name - or die "all_from called with no args without setting name() first"; + my $name = $self->name or die( + "all_from called with no args without setting name() first" + ); $file = join('/', 'lib', split(/-/, $name)) . '.pm'; $file =~ s{.*/}{} unless -e $file; - die "all_from: cannot find $file from $name" unless -e $file; + unless ( -e $file ) { + die("all_from cannot find $file from $name"); + } + } + unless ( -f $file ) { + die("The path '$file' does not exist, or is not a file"); } # Some methods pull from POD instead of code. @@ -171,7 +249,7 @@ sub provides { my $self = shift; - my $provides = ( $self->{values}{provides} ||= {} ); + my $provides = ( $self->{values}->{provides} ||= {} ); %$provides = (%$provides, @_) if @_; return $provides; } @@ -200,7 +278,7 @@ sub feature { my $self = shift; my $name = shift; - my $features = ( $self->{values}{features} ||= [] ); + my $features = ( $self->{values}->{features} ||= [] ); my $mods; if ( @_ == 1 and ref( $_[0] ) ) { @@ -236,8 +314,8 @@ sub no_index { my $self = shift; my $type = shift; - push @{ $self->{values}{no_index}{$type} }, @_ if $type; - return $self->{values}{no_index}; + push @{ $self->{values}->{no_index}->{$type} }, @_ if $type; + return $self->{values}->{no_index}; } sub read { @@ -303,7 +381,7 @@ $self->module_name($module_name); } } else { - die "Cannot determine name from $file\n"; + die("Cannot determine name from $file\n"); } } @@ -361,24 +439,25 @@ /ixms ) { my $license_text = $1; my @phrases = ( - 'under the same (?:terms|license) as perl itself' => 'perl', 1, - 'GNU public license' => 'gpl', 1, - 'GNU lesser public license' => 'lgpl', 1, - 'BSD license' => 'bsd', 1, - 'Artistic license' => 'artistic', 1, - 'GPL' => 'gpl', 1, - 'LGPL' => 'lgpl', 1, - 'BSD' => 'bsd', 1, - 'Artistic' => 'artistic', 1, - 'MIT' => 'mit', 1, - 'proprietary' => 'proprietary', 0, + 'under the same (?:terms|license) as (?:perl|the perl programming language) itself' => 'perl', 1, + 'GNU general public license' => 'gpl', 1, + 'GNU public license' => 'gpl', 1, + 'GNU lesser general public license' => 'lgpl', 1, + 'GNU lesser public license' => 'lgpl', 1, + 'GNU library general public license' => 'lgpl', 1, + 'GNU library public license' => 'lgpl', 1, + 'BSD license' => 'bsd', 1, + 'Artistic license' => 'artistic', 1, + 'GPL' => 'gpl', 1, + 'LGPL' => 'lgpl', 1, + 'BSD' => 'bsd', 1, + 'Artistic' => 'artistic', 1, + 'MIT' => 'mit', 1, + 'proprietary' => 'proprietary', 0, ); while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) { $pattern =~ s{\s+}{\\s+}g; if ( $license_text =~ /\b$pattern\b/i ) { - if ( $osi and $license_text =~ /All rights reserved/i ) { - print "WARNING: 'All rights reserved' in copyright may invalidate Open Source license.\n"; - } $self->license($license); return 1; } @@ -389,19 +468,157 @@ return 'unknown'; } -sub install_script { +sub _extract_bugtracker { + my @links = $_[0] =~ m#L<(\Qhttp://rt.cpan.org/\E[^>]+)>#g; + my %links; + @links{@links}=(); + @links=keys %links; + return @links; +} + +sub bugtracker_from { + my $self = shift; + my $content = Module::Install::_read($_[0]); + my @links = _extract_bugtracker($content); + unless ( @links ) { + warn "Cannot determine bugtracker info from $_[0]\n"; + return 0; + } + if ( @links > 1 ) { + warn "Found more than on rt.cpan.org link in $_[0]\n"; + return 0; + } + + # Set the bugtracker + bugtracker( $links[0] ); + return 1; +} + +sub requires_from { + my $self = shift; + my $content = Module::Install::_readperl($_[0]); + my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg; + while ( @requires ) { + my $module = shift @requires; + my $version = shift @requires; + $self->requires( $module => $version ); + } +} + +sub test_requires_from { + my $self = shift; + my $content = Module::Install::_readperl($_[0]); + my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg; + while ( @requires ) { + my $module = shift @requires; + my $version = shift @requires; + $self->test_requires( $module => $version ); + } +} + +# Convert triple-part versions (eg, 5.6.1 or 5.8.9) to +# numbers (eg, 5.006001 or 5.008009). +# Also, convert double-part versions (eg, 5.8) +sub _perl_version { + my $v = $_[-1]; + $v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e; + $v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 || 0)/e; + $v =~ s/(\.\d\d\d)000$/$1/; + $v =~ s/_.+$//; + if ( ref($v) ) { + # Numify + $v = $v + 0; + } + return $v; +} + + + + + +###################################################################### +# MYMETA Support + +sub WriteMyMeta { + die "WriteMyMeta has been deprecated"; +} + +sub write_mymeta_yaml { my $self = shift; - my $args = $self->makemaker_args; - my $exe = $args->{EXE_FILES} ||= []; - foreach ( @_ ) { - if ( -f $_ ) { - push @$exe, $_; - } elsif ( -d 'script' and -f "script/$_" ) { - push @$exe, "script/$_"; - } else { - die "Cannot find script '$_'"; + + # We need YAML::Tiny to write the MYMETA.yml file + unless ( eval { require YAML::Tiny; 1; } ) { + return 1; + } + + # Generate the data + my $meta = $self->_write_mymeta_data or return 1; + + # Save as the MYMETA.yml file + print "Writing MYMETA.yml\n"; + YAML::Tiny::DumpFile('MYMETA.yml', $meta); +} + +sub write_mymeta_json { + my $self = shift; + + # We need JSON to write the MYMETA.json file + unless ( eval { require JSON; 1; } ) { + return 1; + } + + # Generate the data + my $meta = $self->_write_mymeta_data or return 1; + + # Save as the MYMETA.yml file + print "Writing MYMETA.json\n"; + Module::Install::_write( + 'MYMETA.json', + JSON->new->pretty(1)->canonical->encode($meta), + ); +} + +sub _write_mymeta_data { + my $self = shift; + + # If there's no existing META.yml there is nothing we can do + return undef unless -f 'META.yml'; + + # We need Parse::CPAN::Meta to load the file + unless ( eval { require Parse::CPAN::Meta; 1; } ) { + return undef; + } + + # Merge the perl version into the dependencies + my $val = $self->Meta->{values}; + my $perl = delete $val->{perl_version}; + if ( $perl ) { + $val->{requires} ||= []; + my $requires = $val->{requires}; + + # Canonize to three-dot version after Perl 5.6 + if ( $perl >= 5.006 ) { + $perl =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2||0), int($3||0))}e } + unshift @$requires, [ perl => $perl ]; } + + # Load the advisory META.yml file + my @yaml = Parse::CPAN::Meta::LoadFile('META.yml'); + my $meta = $yaml[0]; + + # Overwrite the non-configure dependency hashs + delete $meta->{requires}; + delete $meta->{build_requires}; + delete $meta->{recommends}; + if ( exists $val->{requires} ) { + $meta->{requires} = { map { @$_ } @{ $val->{requires} } }; + } + if ( exists $val->{build_requires} ) { + $meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } }; + } + + return $meta; } 1; diff -Nru /tmp/MQ70iNNc2v/libauthen-sasl-perl-2.12/inc/Module/Install/Win32.pm /tmp/c5NcsEjNyt/libauthen-sasl-perl-2.13/inc/Module/Install/Win32.pm --- libauthen-sasl-perl-2.12/inc/Module/Install/Win32.pm 2008-07-01 03:57:02.000000000 +0100 +++ libauthen-sasl-perl-2.13/inc/Module/Install/Win32.pm 2009-09-24 23:35:07.000000000 +0100 @@ -2,12 +2,12 @@ package Module::Install::Win32; use strict; -use Module::Install::Base; +use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { - $VERSION = '0.75'; - @ISA = qw{Module::Install::Base}; + $VERSION = '0.91'; + @ISA = 'Module::Install::Base'; $ISCORE = 1; } diff -Nru /tmp/MQ70iNNc2v/libauthen-sasl-perl-2.12/inc/Module/Install/WriteAll.pm /tmp/c5NcsEjNyt/libauthen-sasl-perl-2.13/inc/Module/Install/WriteAll.pm --- libauthen-sasl-perl-2.12/inc/Module/Install/WriteAll.pm 1970-01-01 01:00:00.000000000 +0100 +++ libauthen-sasl-perl-2.13/inc/Module/Install/WriteAll.pm 2009-09-24 23:35:07.000000000 +0100 @@ -0,0 +1,60 @@ +#line 1 +package Module::Install::WriteAll; + +use strict; +use Module::Install::Base (); + +use vars qw{$VERSION @ISA $ISCORE}; +BEGIN { + $VERSION = '0.91';; + @ISA = qw{Module::Install::Base}; + $ISCORE = 1; +} + +sub WriteAll { + my $self = shift; + my %args = ( + meta => 1, + sign => 0, + inline => 0, + check_nmake => 1, + @_, + ); + + $self->sign(1) if $args{sign}; + $self->admin->WriteAll(%args) if $self->is_admin; + + $self->check_nmake if $args{check_nmake}; + unless ( $self->makemaker_args->{PL_FILES} ) { + $self->makemaker_args( PL_FILES => {} ); + } + + # Until ExtUtils::MakeMaker support MYMETA.yml, make sure + # we clean it up properly ourself. + $self->realclean_files('MYMETA.yml'); + + if ( $args{inline} ) { + $self->Inline->write; + } else { + $self->Makefile->write; + } + + # The Makefile write process adds a couple of dependencies, + # so write the META.yml files after the Makefile. + if ( $args{meta} ) { + $self->Meta->write; + } + + # Experimental support for MYMETA + if ( $ENV{X_MYMETA} ) { + if ( $ENV{X_MYMETA} eq 'JSON' ) { + $self->Meta->write_mymeta_json; + } else { + $self->Meta->write_mymeta_yaml; + } + } + + return 1; +} + +1; diff -Nru /tmp/MQ70iNNc2v/libauthen-sasl-perl-2.12/inc/Module/Install.pm /tmp/c5NcsEjNyt/libauthen-sasl-perl-2.13/inc/Module/Install.pm --- libauthen-sasl-perl-2.12/inc/Module/Install.pm 2008-07-01 03:57:02.000000000 +0100 +++ libauthen-sasl-perl-2.13/inc/Module/Install.pm 2009-09-24 23:35:07.000000000 +0100 @@ -17,12 +17,10 @@ # 3. The ./inc/ version of Module::Install loads # } -BEGIN { - require 5.004; -} +use 5.005; use strict 'vars'; -use vars qw{$VERSION}; +use vars qw{$VERSION $MAIN}; BEGIN { # All Module::Install core packages now require synchronised versions. # This will be used to ensure we don't accidentally load old or @@ -30,7 +28,10 @@ # This is not enforced yet, but will be some time in the next few # releases once we can make sure it won't clash with custom # Module::Install extensions. - $VERSION = '0.75'; + $VERSION = '0.91'; + + # Storage for the pseudo-singleton + $MAIN = undef; *inc::Module::Install::VERSION = *VERSION; @inc::Module::Install::ISA = __PACKAGE__; @@ -69,15 +70,26 @@ # again. This is bad. Rather than taking action to touch it (which # is unreliable on some platforms and requires write permissions) # for now we should catch this and refuse to run. -if ( -f $0 and (stat($0))[9] > time ) { die <<"END_DIE" } +if ( -f $0 ) { + my $s = (stat($0))[9]; -Your installer $0 has a modification time in the future. + # If the modification time is only slightly in the future, + # sleep briefly to remove the problem. + my $a = $s - time; + if ( $a > 0 and $a < 5 ) { sleep 5 } + + # Too far in the future, throw an error. + my $t = time; + if ( $s > $t ) { die <<"END_DIE" } + +Your installer $0 has a modification time in the future ($s > $t). This is known to create infinite loops in make. Please correct this, then run $0 again. END_DIE +} @@ -121,12 +133,22 @@ $sym->{$cwd} = sub { my $pwd = Cwd::cwd(); if ( my $code = $sym->{$pwd} ) { - # delegate back to parent dirs + # Delegate back to parent dirs goto &$code unless $cwd eq $pwd; } $$sym =~ /([^:]+)$/ or die "Cannot autoload $who - $sym"; + my $method = $1; + if ( uc($method) eq $method ) { + # Do nothing + return; + } elsif ( $method =~ /^_/ and $self->can($method) ) { + # Dispatch to the root M:I class + return $self->$method(@_); + } + + # Dispatch to the appropriate plugin unshift @_, ( $self, $1 ); - goto &{$self->can('call')} unless uc($1) eq $1; + goto &{$self->can('call')}; }; } @@ -151,6 +173,9 @@ delete $INC{"$self->{file}"}; delete $INC{"$self->{path}.pm"}; + # Save to the singleton + $MAIN = $self; + return 1; } @@ -164,8 +189,7 @@ my @exts = @{$self->{extensions}}; unless ( @exts ) { - my $admin = $self->{admin}; - @exts = $admin->load_all_extensions; + @exts = $self->{admin}->load_all_extensions; } my %seen; @@ -248,7 +272,7 @@ sub load_extensions { my ($self, $path, $top) = @_; - unless ( grep { lc $_ eq lc $self->{prefix} } @INC ) { + unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) { unshift @INC, $self->{prefix}; } @@ -312,7 +336,7 @@ ##################################################################### -# Utility Functions +# Common Utility Functions sub _caller { my $depth = 0; @@ -326,28 +350,81 @@ sub _read { local *FH; - open FH, "< $_[0]" or die "open($_[0]): $!"; - my $str = do { local $/; }; + if ( $] >= 5.006 ) { + open( FH, '<', $_[0] ) or die "open($_[0]): $!"; + } else { + open( FH, "< $_[0]" ) or die "open($_[0]): $!"; + } + my $string = do { local $/; }; close FH or die "close($_[0]): $!"; - return $str; + return $string; +} + +sub _readperl { + my $string = Module::Install::_read($_[0]); + $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; + $string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s; + $string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg; + return $string; +} + +sub _readpod { + my $string = Module::Install::_read($_[0]); + $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; + return $string if $_[0] =~ /\.pod\z/; + $string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg; + $string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg; + $string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg; + $string =~ s/^\n+//s; + return $string; } sub _write { local *FH; - open FH, "> $_[0]" or die "open($_[0]): $!"; - foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!" } + if ( $] >= 5.006 ) { + open( FH, '>', $_[0] ) or die "open($_[0]): $!"; + } else { + open( FH, "> $_[0]" ) or die "open($_[0]): $!"; + } + foreach ( 1 .. $#_ ) { + print FH $_[$_] or die "print($_[0]): $!"; + } close FH or die "close($_[0]): $!"; } -sub _version { +# _version is for processing module versions (eg, 1.03_05) not +# Perl versions (eg, 5.8.1). +sub _version ($) { my $s = shift || 0; - $s =~ s/^(\d+)\.?//; + my $d =()= $s =~ /(\.)/g; + if ( $d >= 2 ) { + # Normalise multipart versions + $s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg; + } + $s =~ s/^(\d+)\.?//; my $l = $1 || 0; - my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g; - $l = $l . '.' . join '', @v if @v; + my @v = map { + $_ . '0' x (3 - length $_) + } $s =~ /(\d{1,3})\D?/g; + $l = $l . '.' . join '', @v if @v; return $l + 0; } +sub _cmp ($$) { + _version($_[0]) <=> _version($_[1]); +} + +# Cloned from Params::Util::_CLASS +sub _CLASS ($) { + ( + defined $_[0] + and + ! ref $_[0] + and + $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s + ) ? $_[0] : undef; +} + 1; -# Copyright 2008 Adam Kennedy. +# Copyright 2008 - 2009 Adam Kennedy. diff -Nru /tmp/MQ70iNNc2v/libauthen-sasl-perl-2.12/inc/Test/Builder/Module.pm /tmp/c5NcsEjNyt/libauthen-sasl-perl-2.13/inc/Test/Builder/Module.pm --- libauthen-sasl-perl-2.12/inc/Test/Builder/Module.pm 2008-07-01 03:57:02.000000000 +0100 +++ libauthen-sasl-perl-2.13/inc/Test/Builder/Module.pm 1970-01-01 01:00:00.000000000 +0100 @@ -1,82 +0,0 @@ -#line 1 -package Test::Builder::Module; - -use Test::Builder; - -require Exporter; -@ISA = qw(Exporter); - -$VERSION = '0.02'; - -use strict; - -# 5.004's Exporter doesn't have export_to_level. -my $_export_to_level = sub { - my $pkg = shift; - my $level = shift; - (undef) = shift; # redundant arg - my $callpkg = caller($level); - $pkg->export($callpkg, @_); -}; - - -#line 82 - -sub import { - my($class) = shift; - - my $test = $class->builder; - - my $caller = caller; - - $test->exported_to($caller); - - $class->import_extra(\@_); - my(@imports) = $class->_strip_imports(\@_); - - $test->plan(@_); - - $class->$_export_to_level(1, $class, @imports); -} - - -sub _strip_imports { - my $class = shift; - my $list = shift; - - my @imports = (); - my @other = (); - my $idx = 0; - while( $idx <= $#{$list} ) { - my $item = $list->[$idx]; - - if( defined $item and $item eq 'import' ) { - push @imports, @{$list->[$idx+1]}; - $idx++; - } - else { - push @other, $item; - } - - $idx++; - } - - @$list = @other; - - return @imports; -} - - -#line 144 - -sub import_extra {} - - -#line 175 - -sub builder { - return Test::Builder->new; -} - - -1; diff -Nru /tmp/MQ70iNNc2v/libauthen-sasl-perl-2.12/inc/Test/Builder.pm /tmp/c5NcsEjNyt/libauthen-sasl-perl-2.13/inc/Test/Builder.pm --- libauthen-sasl-perl-2.12/inc/Test/Builder.pm 2008-07-01 03:57:02.000000000 +0100 +++ libauthen-sasl-perl-2.13/inc/Test/Builder.pm 1970-01-01 01:00:00.000000000 +0100 @@ -1,1140 +0,0 @@ -#line 1 -package Test::Builder; - -use 5.004; - -# $^C was only introduced in 5.005-ish. We do this to prevent -# use of uninitialized value warnings in older perls. -$^C ||= 0; - -use strict; -use vars qw($VERSION); -$VERSION = '0.32'; -$VERSION = eval $VERSION; # make the alpha version come out as a number - -# Make Test::Builder thread-safe for ithreads. -BEGIN { - use Config; - # Load threads::shared when threads are turned on - if( $] >= 5.008 && $Config{useithreads} && $INC{'threads.pm'}) { - require threads::shared; - - # Hack around YET ANOTHER threads::shared bug. It would - # occassionally forget the contents of the variable when sharing it. - # So we first copy the data, then share, then put our copy back. - *share = sub (\[$@%]) { - my $type = ref $_[0]; - my $data; - - if( $type eq 'HASH' ) { - %$data = %{$_[0]}; - } - elsif( $type eq 'ARRAY' ) { - @$data = @{$_[0]}; - } - elsif( $type eq 'SCALAR' ) { - $$data = ${$_[0]}; - } - else { - die "Unknown type: ".$type; - } - - $_[0] = &threads::shared::share($_[0]); - - if( $type eq 'HASH' ) { - %{$_[0]} = %$data; - } - elsif( $type eq 'ARRAY' ) { - @{$_[0]} = @$data; - } - elsif( $type eq 'SCALAR' ) { - ${$_[0]} = $$data; - } - else { - die "Unknown type: ".$type; - } - - return $_[0]; - }; - } - # 5.8.0's threads::shared is busted when threads are off. - # We emulate it here. - else { - *share = sub { return $_[0] }; - *lock = sub { 0 }; - } -} - - -#line 127 - -my $Test = Test::Builder->new; -sub new { - my($class) = shift; - $Test ||= $class->create; - return $Test; -} - - -#line 149 - -sub create { - my $class = shift; - - my $self = bless {}, $class; - $self->reset; - - return $self; -} - -#line 168 - -use vars qw($Level); - -sub reset { - my ($self) = @_; - - # We leave this a global because it has to be localized and localizing - # hash keys is just asking for pain. Also, it was documented. - $Level = 1; - - $self->{Test_Died} = 0; - $self->{Have_Plan} = 0; - $self->{No_Plan} = 0; - $self->{Original_Pid} = $$; - - share($self->{Curr_Test}); - $self->{Curr_Test} = 0; - $self->{Test_Results} = &share([]); - - $self->{Exported_To} = undef; - $self->{Expected_Tests} = 0; - - $self->{Skip_All} = 0; - - $self->{Use_Nums} = 1; - - $self->{No_Header} = 0; - $self->{No_Ending} = 0; - - $self->_dup_stdhandles unless $^C; - - return undef; -} - -#line 220 - -sub exported_to { - my($self, $pack) = @_; - - if( defined $pack ) { - $self->{Exported_To} = $pack; - } - return $self->{Exported_To}; -} - -#line 242 - -sub plan { - my($self, $cmd, $arg) = @_; - - return unless $cmd; - - if( $self->{Have_Plan} ) { - die sprintf "You tried to plan twice! Second plan at %s line %d\n", - ($self->caller)[1,2]; - } - - if( $cmd eq 'no_plan' ) { - $self->no_plan; - } - elsif( $cmd eq 'skip_all' ) { - return $self->skip_all($arg); - } - elsif( $cmd eq 'tests' ) { - if( $arg ) { - return $self->expected_tests($arg); - } - elsif( !defined $arg ) { - die "Got an undefined number of tests. Looks like you tried to ". - "say how many tests you plan to run but made a mistake.\n"; - } - elsif( !$arg ) { - die "You said to run 0 tests! You've got to run something.\n"; - } - } - else { - require Carp; - my @args = grep { defined } ($cmd, $arg); - Carp::croak("plan() doesn't understand @args"); - } - - return 1; -} - -#line 289 - -sub expected_tests { - my $self = shift; - my($max) = @_; - - if( @_ ) { - die "Number of tests must be a postive integer. You gave it '$max'.\n" - unless $max =~ /^\+?\d+$/ and $max > 0; - - $self->{Expected_Tests} = $max; - $self->{Have_Plan} = 1; - - $self->_print("1..$max\n") unless $self->no_header; - } - return $self->{Expected_Tests}; -} - - -#line 314 - -sub no_plan { - my $self = shift; - - $self->{No_Plan} = 1; - $self->{Have_Plan} = 1; -} - -#line 329 - -sub has_plan { - my $self = shift; - - return($self->{Expected_Tests}) if $self->{Expected_Tests}; - return('no_plan') if $self->{No_Plan}; - return(undef); -}; - - -#line 347 - -sub skip_all { - my($self, $reason) = @_; - - my $out = "1..0"; - $out .= " # Skip $reason" if $reason; - $out .= "\n"; - - $self->{Skip_All} = 1; - - $self->_print($out) unless $self->no_header; - exit(0); -} - -#line 380 - -sub ok { - my($self, $test, $name) = @_; - - # $test might contain an object which we don't want to accidentally - # store, so we turn it into a boolean. - $test = $test ? 1 : 0; - - unless( $self->{Have_Plan} ) { - require Carp; - Carp::croak("You tried to run a test without a plan! Gotta have a plan."); - } - - lock $self->{Curr_Test}; - $self->{Curr_Test}++; - - # In case $name is a string overloaded object, force it to stringify. - $self->_unoverload_str(\$name); - - $self->diag(<caller; - - my $todo = $self->todo($pack); - $self->_unoverload_str(\$todo); - - my $out; - my $result = &share({}); - - unless( $test ) { - $out .= "not "; - @$result{ 'ok', 'actual_ok' } = ( ( $todo ? 1 : 0 ), 0 ); - } - else { - @$result{ 'ok', 'actual_ok' } = ( 1, $test ); - } - - $out .= "ok"; - $out .= " $self->{Curr_Test}" if $self->use_numbers; - - if( defined $name ) { - $name =~ s|#|\\#|g; # # in a name can confuse Test::Harness. - $out .= " - $name"; - $result->{name} = $name; - } - else { - $result->{name} = ''; - } - - if( $todo ) { - $out .= " # TODO $todo"; - $result->{reason} = $todo; - $result->{type} = 'todo'; - } - else { - $result->{reason} = ''; - $result->{type} = ''; - } - - $self->{Test_Results}[$self->{Curr_Test}-1] = $result; - $out .= "\n"; - - $self->_print($out); - - unless( $test ) { - my $msg = $todo ? "Failed (TODO)" : "Failed"; - $self->_print_diag("\n") if $ENV{HARNESS_ACTIVE}; - - if( defined $name ) { - $self->diag(qq[ $msg test '$name'\n]); - $self->diag(qq[ in $file at line $line.\n]); - } - else { - $self->diag(qq[ $msg test in $file at line $line.\n]); - } - } - - return $test ? 1 : 0; -} - - -sub _unoverload { - my $self = shift; - my $type = shift; - - local($@,$!); - - eval { require overload } || return; - - foreach my $thing (@_) { - eval { - if( _is_object($$thing) ) { - if( my $string_meth = overload::Method($$thing, $type) ) { - $$thing = $$thing->$string_meth(); - } - } - }; - } -} - - -sub _is_object { - my $thing = shift; - - return eval { ref $thing && $thing->isa('UNIVERSAL') } ? 1 : 0; -} - - -sub _unoverload_str { - my $self = shift; - - $self->_unoverload(q[""], @_); -} - -sub _unoverload_num { - my $self = shift; - - $self->_unoverload('0+', @_); - - for my $val (@_) { - next unless $self->_is_dualvar($$val); - $$val = $$val+0; - } -} - - -# This is a hack to detect a dualvar such as $! -sub _is_dualvar { - my($self, $val) = @_; - - local $^W = 0; - my $numval = $val+0; - return 1 if $numval != 0 and $numval ne $val; -} - - - -#line 535 - -sub is_eq { - my($self, $got, $expect, $name) = @_; - local $Level = $Level + 1; - - $self->_unoverload_str(\$got, \$expect); - - if( !defined $got || !defined $expect ) { - # undef only matches undef and nothing else - my $test = !defined $got && !defined $expect; - - $self->ok($test, $name); - $self->_is_diag($got, 'eq', $expect) unless $test; - return $test; - } - - return $self->cmp_ok($got, 'eq', $expect, $name); -} - -sub is_num { - my($self, $got, $expect, $name) = @_; - local $Level = $Level + 1; - - $self->_unoverload_num(\$got, \$expect); - - if( !defined $got || !defined $expect ) { - # undef only matches undef and nothing else - my $test = !defined $got && !defined $expect; - - $self->ok($test, $name); - $self->_is_diag($got, '==', $expect) unless $test; - return $test; - } - - return $self->cmp_ok($got, '==', $expect, $name); -} - -sub _is_diag { - my($self, $got, $type, $expect) = @_; - - foreach my $val (\$got, \$expect) { - if( defined $$val ) { - if( $type eq 'eq' ) { - # quote and force string context - $$val = "'$$val'" - } - else { - # force numeric context - $self->_unoverload_num($val); - } - } - else { - $$val = 'undef'; - } - } - - return $self->diag(sprintf <ok($test, $name); - $self->_cmp_diag($got, 'ne', $dont_expect) unless $test; - return $test; - } - - return $self->cmp_ok($got, 'ne', $dont_expect, $name); -} - -sub isnt_num { - my($self, $got, $dont_expect, $name) = @_; - local $Level = $Level + 1; - - if( !defined $got || !defined $dont_expect ) { - # undef only matches undef and nothing else - my $test = defined $got || defined $dont_expect; - - $self->ok($test, $name); - $self->_cmp_diag($got, '!=', $dont_expect) unless $test; - return $test; - } - - return $self->cmp_ok($got, '!=', $dont_expect, $name); -} - - -#line 665 - -sub like { - my($self, $this, $regex, $name) = @_; - - local $Level = $Level + 1; - $self->_regex_ok($this, $regex, '=~', $name); -} - -sub unlike { - my($self, $this, $regex, $name) = @_; - - local $Level = $Level + 1; - $self->_regex_ok($this, $regex, '!~', $name); -} - -#line 706 - - -sub maybe_regex { - my ($self, $regex) = @_; - my $usable_regex = undef; - - return $usable_regex unless defined $regex; - - my($re, $opts); - - # Check for qr/foo/ - if( ref $regex eq 'Regexp' ) { - $usable_regex = $regex; - } - # Check for '/foo/' or 'm,foo,' - elsif( ($re, $opts) = $regex =~ m{^ /(.*)/ (\w*) $ }sx or - (undef, $re, $opts) = $regex =~ m,^ m([^\w\s]) (.+) \1 (\w*) $,sx - ) - { - $usable_regex = length $opts ? "(?$opts)$re" : $re; - } - - return $usable_regex; -}; - -sub _regex_ok { - my($self, $this, $regex, $cmp, $name) = @_; - - my $ok = 0; - my $usable_regex = $self->maybe_regex($regex); - unless (defined $usable_regex) { - $ok = $self->ok( 0, $name ); - $self->diag(" '$regex' doesn't look much like a regex to me."); - return $ok; - } - - { - my $test; - my $code = $self->_caller_context; - - local($@, $!); - - # Yes, it has to look like this or 5.4.5 won't see the #line directive. - # Don't ask me, man, I just work here. - $test = eval " -$code" . q{$test = $this =~ /$usable_regex/ ? 1 : 0}; - - $test = !$test if $cmp eq '!~'; - - local $Level = $Level + 1; - $ok = $self->ok( $test, $name ); - } - - unless( $ok ) { - $this = defined $this ? "'$this'" : 'undef'; - my $match = $cmp eq '=~' ? "doesn't match" : "matches"; - $self->diag(sprintf <", ">=", "==", "!=", "<=>"); - -sub cmp_ok { - my($self, $got, $type, $expect, $name) = @_; - - # Treat overloaded objects as numbers if we're asked to do a - # numeric comparison. - my $unoverload = $numeric_cmps{$type} ? '_unoverload_num' - : '_unoverload_str'; - - $self->$unoverload(\$got, \$expect); - - - my $test; - { - local($@,$!); # don't interfere with $@ - # eval() sometimes resets $! - - my $code = $self->_caller_context; - - # Yes, it has to look like this or 5.4.5 won't see the #line directive. - # Don't ask me, man, I just work here. - $test = eval " -$code" . "\$got $type \$expect;"; - - } - local $Level = $Level + 1; - my $ok = $self->ok($test, $name); - - unless( $ok ) { - if( $type =~ /^(eq|==)$/ ) { - $self->_is_diag($got, $type, $expect); - } - else { - $self->_cmp_diag($got, $type, $expect); - } - } - return $ok; -} - -sub _cmp_diag { - my($self, $got, $type, $expect) = @_; - - $got = defined $got ? "'$got'" : 'undef'; - $expect = defined $expect ? "'$expect'" : 'undef'; - return $self->diag(sprintf <caller(1); - - my $code = ''; - $code .= "#line $line $file\n" if defined $file and defined $line; - - return $code; -} - - -#line 860 - -sub BAIL_OUT { - my($self, $reason) = @_; - - $self->{Bailed_Out} = 1; - $self->_print("Bail out! $reason"); - exit 255; -} - -#line 873 - -*BAILOUT = \&BAIL_OUT; - - -#line 885 - -sub skip { - my($self, $why) = @_; - $why ||= ''; - $self->_unoverload_str(\$why); - - unless( $self->{Have_Plan} ) { - require Carp; - Carp::croak("You tried to run tests without a plan! Gotta have a plan."); - } - - lock($self->{Curr_Test}); - $self->{Curr_Test}++; - - $self->{Test_Results}[$self->{Curr_Test}-1] = &share({ - 'ok' => 1, - actual_ok => 1, - name => '', - type => 'skip', - reason => $why, - }); - - my $out = "ok"; - $out .= " $self->{Curr_Test}" if $self->use_numbers; - $out .= " # skip"; - $out .= " $why" if length $why; - $out .= "\n"; - - $self->_print($out); - - return 1; -} - - -#line 930 - -sub todo_skip { - my($self, $why) = @_; - $why ||= ''; - - unless( $self->{Have_Plan} ) { - require Carp; - Carp::croak("You tried to run tests without a plan! Gotta have a plan."); - } - - lock($self->{Curr_Test}); - $self->{Curr_Test}++; - - $self->{Test_Results}[$self->{Curr_Test}-1] = &share({ - 'ok' => 1, - actual_ok => 0, - name => '', - type => 'todo_skip', - reason => $why, - }); - - my $out = "not ok"; - $out .= " $self->{Curr_Test}" if $self->use_numbers; - $out .= " # TODO & SKIP $why\n"; - - $self->_print($out); - - return 1; -} - - -#line 1001 - -sub level { - my($self, $level) = @_; - - if( defined $level ) { - $Level = $level; - } - return $Level; -} - - -#line 1036 - -sub use_numbers { - my($self, $use_nums) = @_; - - if( defined $use_nums ) { - $self->{Use_Nums} = $use_nums; - } - return $self->{Use_Nums}; -} - - -#line 1070 - -foreach my $attribute (qw(No_Header No_Ending No_Diag)) { - my $method = lc $attribute; - - my $code = sub { - my($self, $no) = @_; - - if( defined $no ) { - $self->{$attribute} = $no; - } - return $self->{$attribute}; - }; - - no strict 'refs'; - *{__PACKAGE__.'::'.$method} = $code; -} - - -#line 1124 - -sub diag { - my($self, @msgs) = @_; - - return if $self->no_diag; - return unless @msgs; - - # Prevent printing headers when compiling (i.e. -c) - return if $^C; - - # Smash args together like print does. - # Convert undef to 'undef' so its readable. - my $msg = join '', map { defined($_) ? $_ : 'undef' } @msgs; - - # Escape each line with a #. - $msg =~ s/^/# /gm; - - # Stick a newline on the end if it needs it. - $msg .= "\n" unless $msg =~ /\n\Z/; - - local $Level = $Level + 1; - $self->_print_diag($msg); - - return 0; -} - -#line 1161 - -sub _print { - my($self, @msgs) = @_; - - # Prevent printing headers when only compiling. Mostly for when - # tests are deparsed with B::Deparse - return if $^C; - - my $msg = join '', @msgs; - - local($\, $", $,) = (undef, ' ', ''); - my $fh = $self->output; - - # Escape each line after the first with a # so we don't - # confuse Test::Harness. - $msg =~ s/\n(.)/\n# $1/sg; - - # Stick a newline on the end if it needs it. - $msg .= "\n" unless $msg =~ /\n\Z/; - - print $fh $msg; -} - - -#line 1192 - -sub _print_diag { - my $self = shift; - - local($\, $", $,) = (undef, ' ', ''); - my $fh = $self->todo ? $self->todo_output : $self->failure_output; - print $fh @_; -} - -#line 1229 - -sub output { - my($self, $fh) = @_; - - if( defined $fh ) { - $self->{Out_FH} = _new_fh($fh); - } - return $self->{Out_FH}; -} - -sub failure_output { - my($self, $fh) = @_; - - if( defined $fh ) { - $self->{Fail_FH} = _new_fh($fh); - } - return $self->{Fail_FH}; -} - -sub todo_output { - my($self, $fh) = @_; - - if( defined $fh ) { - $self->{Todo_FH} = _new_fh($fh); - } - return $self->{Todo_FH}; -} - - -sub _new_fh { - my($file_or_fh) = shift; - - my $fh; - if( _is_fh($file_or_fh) ) { - $fh = $file_or_fh; - } - else { - $fh = do { local *FH }; - open $fh, ">$file_or_fh" or - die "Can't open test output log $file_or_fh: $!"; - _autoflush($fh); - } - - return $fh; -} - - -sub _is_fh { - my $maybe_fh = shift; - return 0 unless defined $maybe_fh; - - return 1 if ref \$maybe_fh eq 'GLOB'; # its a glob - - return UNIVERSAL::isa($maybe_fh, 'GLOB') || - UNIVERSAL::isa($maybe_fh, 'IO::Handle') || - - # 5.5.4's tied() and can() doesn't like getting undef - UNIVERSAL::can((tied($maybe_fh) || ''), 'TIEHANDLE'); -} - - -sub _autoflush { - my($fh) = shift; - my $old_fh = select $fh; - $| = 1; - select $old_fh; -} - - -sub _dup_stdhandles { - my $self = shift; - - $self->_open_testhandles; - - # Set everything to unbuffered else plain prints to STDOUT will - # come out in the wrong order from our own prints. - _autoflush(\*TESTOUT); - _autoflush(\*STDOUT); - _autoflush(\*TESTERR); - _autoflush(\*STDERR); - - $self->output(\*TESTOUT); - $self->failure_output(\*TESTERR); - $self->todo_output(\*TESTOUT); -} - - -my $Opened_Testhandles = 0; -sub _open_testhandles { - return if $Opened_Testhandles; - # We dup STDOUT and STDERR so people can change them in their - # test suites while still getting normal test output. - open(TESTOUT, ">&STDOUT") or die "Can't dup STDOUT: $!"; - open(TESTERR, ">&STDERR") or die "Can't dup STDERR: $!"; - $Opened_Testhandles = 1; -} - - -#line 1347 - -sub current_test { - my($self, $num) = @_; - - lock($self->{Curr_Test}); - if( defined $num ) { - unless( $self->{Have_Plan} ) { - require Carp; - Carp::croak("Can't change the current test number without a plan!"); - } - - $self->{Curr_Test} = $num; - - # If the test counter is being pushed forward fill in the details. - my $test_results = $self->{Test_Results}; - if( $num > @$test_results ) { - my $start = @$test_results ? @$test_results : 0; - for ($start..$num-1) { - $test_results->[$_] = &share({ - 'ok' => 1, - actual_ok => undef, - reason => 'incrementing test number', - type => 'unknown', - name => undef - }); - } - } - # If backward, wipe history. Its their funeral. - elsif( $num < @$test_results ) { - $#{$test_results} = $num - 1; - } - } - return $self->{Curr_Test}; -} - - -#line 1393 - -sub summary { - my($self) = shift; - - return map { $_->{'ok'} } @{ $self->{Test_Results} }; -} - -#line 1448 - -sub details { - my $self = shift; - return @{ $self->{Test_Results} }; -} - -#line 1473 - -sub todo { - my($self, $pack) = @_; - - $pack = $pack || $self->exported_to || $self->caller($Level); - return 0 unless $pack; - - no strict 'refs'; - return defined ${$pack.'::TODO'} ? ${$pack.'::TODO'} - : 0; -} - -#line 1494 - -sub caller { - my($self, $height) = @_; - $height ||= 0; - - my @caller = CORE::caller($self->level + $height + 1); - return wantarray ? @caller : $caller[0]; -} - -#line 1506 - -#line 1520 - -#'# -sub _sanity_check { - my $self = shift; - - _whoa($self->{Curr_Test} < 0, 'Says here you ran a negative number of tests!'); - _whoa(!$self->{Have_Plan} and $self->{Curr_Test}, - 'Somehow your tests ran without a plan!'); - _whoa($self->{Curr_Test} != @{ $self->{Test_Results} }, - 'Somehow you got a different number of results than tests ran!'); -} - -#line 1541 - -sub _whoa { - my($check, $desc) = @_; - if( $check ) { - die <{Test_Died} = 1 unless $in_eval; -}; - -sub _ending { - my $self = shift; - - $self->_sanity_check(); - - # Don't bother with an ending if this is a forked copy. Only the parent - # should do the ending. - # Exit if plan() was never called. This is so "require Test::Simple" - # doesn't puke. - # Don't do an ending if we bailed out. - if( ($self->{Original_Pid} != $$) or - (!$self->{Have_Plan} && !$self->{Test_Died}) or - $self->{Bailed_Out} - ) - { - _my_exit($?); - return; - } - - # Figure out if we passed or failed and print helpful messages. - my $test_results = $self->{Test_Results}; - if( @$test_results ) { - # The plan? We have no plan. - if( $self->{No_Plan} ) { - $self->_print("1..$self->{Curr_Test}\n") unless $self->no_header; - $self->{Expected_Tests} = $self->{Curr_Test}; - } - - # Auto-extended arrays and elements which aren't explicitly - # filled in with a shared reference will puke under 5.8.0 - # ithreads. So we have to fill them in by hand. :( - my $empty_result = &share({}); - for my $idx ( 0..$self->{Expected_Tests}-1 ) { - $test_results->[$idx] = $empty_result - unless defined $test_results->[$idx]; - } - - my $num_failed = grep !$_->{'ok'}, - @{$test_results}[0..$self->{Curr_Test}-1]; - - my $num_extra = $self->{Curr_Test} - $self->{Expected_Tests}; - - if( $num_extra < 0 ) { - my $s = $self->{Expected_Tests} == 1 ? '' : 's'; - $self->diag(<<"FAIL"); -Looks like you planned $self->{Expected_Tests} test$s but only ran $self->{Curr_Test}. -FAIL - } - elsif( $num_extra > 0 ) { - my $s = $self->{Expected_Tests} == 1 ? '' : 's'; - $self->diag(<<"FAIL"); -Looks like you planned $self->{Expected_Tests} test$s but ran $num_extra extra. -FAIL - } - - if ( $num_failed ) { - my $num_tests = $self->{Curr_Test}; - my $s = $num_failed == 1 ? '' : 's'; - - my $qualifier = $num_extra == 0 ? '' : ' run'; - - $self->diag(<<"FAIL"); -Looks like you failed $num_failed test$s of $num_tests$qualifier. -FAIL - } - - if( $self->{Test_Died} ) { - $self->diag(<<"FAIL"); -Looks like your test died just after $self->{Curr_Test}. -FAIL - - _my_exit( 255 ) && return; - } - - my $exit_code; - if( $num_failed ) { - $exit_code = $num_failed <= 254 ? $num_failed : 254; - } - elsif( $num_extra != 0 ) { - $exit_code = 255; - } - else { - $exit_code = 0; - } - - _my_exit( $exit_code ) && return; - } - elsif ( $self->{Skip_All} ) { - _my_exit( 0 ) && return; - } - elsif ( $self->{Test_Died} ) { - $self->diag(<<'FAIL'); -Looks like your test died before it could output anything. -FAIL - _my_exit( 255 ) && return; - } - else { - $self->diag("No tests run!\n"); - _my_exit( 255 ) && return; - } -} - -END { - $Test->_ending if defined $Test and !$Test->no_ending; -} - -#line 1747 - -1; diff -Nru /tmp/MQ70iNNc2v/libauthen-sasl-perl-2.12/inc/Test/More.pm /tmp/c5NcsEjNyt/libauthen-sasl-perl-2.13/inc/Test/More.pm --- libauthen-sasl-perl-2.12/inc/Test/More.pm 2008-07-01 03:57:02.000000000 +0100 +++ libauthen-sasl-perl-2.13/inc/Test/More.pm 1970-01-01 01:00:00.000000000 +0100 @@ -1,657 +0,0 @@ -#line 1 -package Test::More; - -use 5.004; - -use strict; - - -# Can't use Carp because it might cause use_ok() to accidentally succeed -# even though the module being used forgot to use Carp. Yes, this -# actually happened. -sub _carp { - my($file, $line) = (caller(1))[1,2]; - warn @_, " at $file line $line\n"; -} - - - -use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS $TODO); -$VERSION = '0.62'; -$VERSION = eval $VERSION; # make the alpha version come out as a number - -use Test::Builder::Module; -@ISA = qw(Test::Builder::Module); -@EXPORT = qw(ok use_ok require_ok - is isnt like unlike is_deeply - cmp_ok - skip todo todo_skip - pass fail - eq_array eq_hash eq_set - $TODO - plan - can_ok isa_ok - diag - BAIL_OUT - ); - - -#line 157 - -sub plan { - my $tb = Test::More->builder; - - $tb->plan(@_); -} - - -# This implements "use Test::More 'no_diag'" but the behavior is -# deprecated. -sub import_extra { - my $class = shift; - my $list = shift; - - my @other = (); - my $idx = 0; - while( $idx <= $#{$list} ) { - my $item = $list->[$idx]; - - if( defined $item and $item eq 'no_diag' ) { - $class->builder->no_diag(1); - } - else { - push @other, $item; - } - - $idx++; - } - - @$list = @other; -} - - -#line 257 - -sub ok ($;$) { - my($test, $name) = @_; - my $tb = Test::More->builder; - - $tb->ok($test, $name); -} - -#line 324 - -sub is ($$;$) { - my $tb = Test::More->builder; - - $tb->is_eq(@_); -} - -sub isnt ($$;$) { - my $tb = Test::More->builder; - - $tb->isnt_eq(@_); -} - -*isn't = \&isnt; - - -#line 369 - -sub like ($$;$) { - my $tb = Test::More->builder; - - $tb->like(@_); -} - - -#line 385 - -sub unlike ($$;$) { - my $tb = Test::More->builder; - - $tb->unlike(@_); -} - - -#line 425 - -sub cmp_ok($$$;$) { - my $tb = Test::More->builder; - - $tb->cmp_ok(@_); -} - - -#line 461 - -sub can_ok ($@) { - my($proto, @methods) = @_; - my $class = ref $proto || $proto; - my $tb = Test::More->builder; - - unless( @methods ) { - my $ok = $tb->ok( 0, "$class->can(...)" ); - $tb->diag(' can_ok() called with no methods'); - return $ok; - } - - my @nok = (); - foreach my $method (@methods) { - local($!, $@); # don't interfere with caller's $@ - # eval sometimes resets $! - eval { $proto->can($method) } || push @nok, $method; - } - - my $name; - $name = @methods == 1 ? "$class->can('$methods[0]')" - : "$class->can(...)"; - - my $ok = $tb->ok( !@nok, $name ); - - $tb->diag(map " $class->can('$_') failed\n", @nok); - - return $ok; -} - -#line 519 - -sub isa_ok ($$;$) { - my($object, $class, $obj_name) = @_; - my $tb = Test::More->builder; - - my $diag; - $obj_name = 'The object' unless defined $obj_name; - my $name = "$obj_name isa $class"; - if( !defined $object ) { - $diag = "$obj_name isn't defined"; - } - elsif( !ref $object ) { - $diag = "$obj_name isn't a reference"; - } - else { - # We can't use UNIVERSAL::isa because we want to honor isa() overrides - local($@, $!); # eval sometimes resets $! - my $rslt = eval { $object->isa($class) }; - if( $@ ) { - if( $@ =~ /^Can't call method "isa" on unblessed reference/ ) { - if( !UNIVERSAL::isa($object, $class) ) { - my $ref = ref $object; - $diag = "$obj_name isn't a '$class' it's a '$ref'"; - } - } else { - die <isa on your object and got some weird error. -This should never happen. Please contact the author immediately. -Here's the error. -$@ -WHOA - } - } - elsif( !$rslt ) { - my $ref = ref $object; - $diag = "$obj_name isn't a '$class' it's a '$ref'"; - } - } - - - - my $ok; - if( $diag ) { - $ok = $tb->ok( 0, $name ); - $tb->diag(" $diag\n"); - } - else { - $ok = $tb->ok( 1, $name ); - } - - return $ok; -} - - -#line 589 - -sub pass (;$) { - my $tb = Test::More->builder; - $tb->ok(1, @_); -} - -sub fail (;$) { - my $tb = Test::More->builder; - $tb->ok(0, @_); -} - -#line 650 - -sub use_ok ($;@) { - my($module, @imports) = @_; - @imports = () unless @imports; - my $tb = Test::More->builder; - - my($pack,$filename,$line) = caller; - - local($@,$!); # eval sometimes interferes with $! - - if( @imports == 1 and $imports[0] =~ /^\d+(?:\.\d+)?$/ ) { - # probably a version check. Perl needs to see the bare number - # for it to work with non-Exporter based modules. - eval <ok( !$@, "use $module;" ); - - unless( $ok ) { - chomp $@; - $@ =~ s{^BEGIN failed--compilation aborted at .*$} - {BEGIN failed--compilation aborted at $filename line $line.}m; - $tb->diag(<builder; - - my $pack = caller; - - # Try to deterine if we've been given a module name or file. - # Module names must be barewords, files not. - $module = qq['$module'] unless _is_module_name($module); - - local($!, $@); # eval sometimes interferes with $! - eval <ok( !$@, "require $module;" ); - - unless( $ok ) { - chomp $@; - $tb->diag(<builder; - - unless( @_ == 2 or @_ == 3 ) { - my $msg = <ok(0); - } - - my($this, $that, $name) = @_; - - $tb->_unoverload_str(\$that, \$this); - - my $ok; - if( !ref $this and !ref $that ) { # neither is a reference - $ok = $tb->is_eq($this, $that, $name); - } - elsif( !ref $this xor !ref $that ) { # one's a reference, one isn't - $ok = $tb->ok(0, $name); - $tb->diag( _format_stack({ vals => [ $this, $that ] }) ); - } - else { # both references - local @Data_Stack = (); - if( _deep_check($this, $that) ) { - $ok = $tb->ok(1, $name); - } - else { - $ok = $tb->ok(0, $name); - $tb->diag(_format_stack(@Data_Stack)); - } - } - - return $ok; -} - -sub _format_stack { - my(@Stack) = @_; - - my $var = '$FOO'; - my $did_arrow = 0; - foreach my $entry (@Stack) { - my $type = $entry->{type} || ''; - my $idx = $entry->{'idx'}; - if( $type eq 'HASH' ) { - $var .= "->" unless $did_arrow++; - $var .= "{$idx}"; - } - elsif( $type eq 'ARRAY' ) { - $var .= "->" unless $did_arrow++; - $var .= "[$idx]"; - } - elsif( $type eq 'REF' ) { - $var = "\${$var}"; - } - } - - my @vals = @{$Stack[-1]{vals}}[0,1]; - my @vars = (); - ($vars[0] = $var) =~ s/\$FOO/ \$got/; - ($vars[1] = $var) =~ s/\$FOO/\$expected/; - - my $out = "Structures begin differing at:\n"; - foreach my $idx (0..$#vals) { - my $val = $vals[$idx]; - $vals[$idx] = !defined $val ? 'undef' : - $val eq $DNE ? "Does not exist" : - ref $val ? "$val" : - "'$val'"; - } - - $out .= "$vars[0] = $vals[0]\n"; - $out .= "$vars[1] = $vals[1]\n"; - - $out =~ s/^/ /msg; - return $out; -} - - -sub _type { - my $thing = shift; - - return '' if !ref $thing; - - for my $type (qw(ARRAY HASH REF SCALAR GLOB CODE Regexp)) { - return $type if UNIVERSAL::isa($thing, $type); - } - - return ''; -} - -#line 915 - -sub diag { - my $tb = Test::More->builder; - - $tb->diag(@_); -} - - -#line 984 - -#'# -sub skip { - my($why, $how_many) = @_; - my $tb = Test::More->builder; - - unless( defined $how_many ) { - # $how_many can only be avoided when no_plan is in use. - _carp "skip() needs to know \$how_many tests are in the block" - unless $tb->has_plan eq 'no_plan'; - $how_many = 1; - } - - for( 1..$how_many ) { - $tb->skip($why); - } - - local $^W = 0; - last SKIP; -} - - -#line 1066 - -sub todo_skip { - my($why, $how_many) = @_; - my $tb = Test::More->builder; - - unless( defined $how_many ) { - # $how_many can only be avoided when no_plan is in use. - _carp "todo_skip() needs to know \$how_many tests are in the block" - unless $tb->has_plan eq 'no_plan'; - $how_many = 1; - } - - for( 1..$how_many ) { - $tb->todo_skip($why); - } - - local $^W = 0; - last TODO; -} - -#line 1119 - -sub BAIL_OUT { - my $reason = shift; - my $tb = Test::More->builder; - - $tb->BAIL_OUT($reason); -} - -#line 1158 - -#'# -sub eq_array { - local @Data_Stack; - _deep_check(@_); -} - -sub _eq_array { - my($a1, $a2) = @_; - - if( grep !_type($_) eq 'ARRAY', $a1, $a2 ) { - warn "eq_array passed a non-array ref"; - return 0; - } - - return 1 if $a1 eq $a2; - - my $ok = 1; - my $max = $#$a1 > $#$a2 ? $#$a1 : $#$a2; - for (0..$max) { - my $e1 = $_ > $#$a1 ? $DNE : $a1->[$_]; - my $e2 = $_ > $#$a2 ? $DNE : $a2->[$_]; - - push @Data_Stack, { type => 'ARRAY', idx => $_, vals => [$e1, $e2] }; - $ok = _deep_check($e1,$e2); - pop @Data_Stack if $ok; - - last unless $ok; - } - - return $ok; -} - -sub _deep_check { - my($e1, $e2) = @_; - my $tb = Test::More->builder; - - my $ok = 0; - - # Effectively turn %Refs_Seen into a stack. This avoids picking up - # the same referenced used twice (such as [\$a, \$a]) to be considered - # circular. - local %Refs_Seen = %Refs_Seen; - - { - # Quiet uninitialized value warnings when comparing undefs. - local $^W = 0; - - $tb->_unoverload_str(\$e1, \$e2); - - # Either they're both references or both not. - my $same_ref = !(!ref $e1 xor !ref $e2); - my $not_ref = (!ref $e1 and !ref $e2); - - if( defined $e1 xor defined $e2 ) { - $ok = 0; - } - elsif ( $e1 == $DNE xor $e2 == $DNE ) { - $ok = 0; - } - elsif ( $same_ref and ($e1 eq $e2) ) { - $ok = 1; - } - elsif ( $not_ref ) { - push @Data_Stack, { type => '', vals => [$e1, $e2] }; - $ok = 0; - } - else { - if( $Refs_Seen{$e1} ) { - return $Refs_Seen{$e1} eq $e2; - } - else { - $Refs_Seen{$e1} = "$e2"; - } - - my $type = _type($e1); - $type = 'DIFFERENT' unless _type($e2) eq $type; - - if( $type eq 'DIFFERENT' ) { - push @Data_Stack, { type => $type, vals => [$e1, $e2] }; - $ok = 0; - } - elsif( $type eq 'ARRAY' ) { - $ok = _eq_array($e1, $e2); - } - elsif( $type eq 'HASH' ) { - $ok = _eq_hash($e1, $e2); - } - elsif( $type eq 'REF' ) { - push @Data_Stack, { type => $type, vals => [$e1, $e2] }; - $ok = _deep_check($$e1, $$e2); - pop @Data_Stack if $ok; - } - elsif( $type eq 'SCALAR' ) { - push @Data_Stack, { type => 'REF', vals => [$e1, $e2] }; - $ok = _deep_check($$e1, $$e2); - pop @Data_Stack if $ok; - } - elsif( $type ) { - push @Data_Stack, { type => $type, vals => [$e1, $e2] }; - $ok = 0; - } - else { - _whoa(1, "No type in _deep_check"); - } - } - } - - return $ok; -} - - -sub _whoa { - my($check, $desc) = @_; - if( $check ) { - die < keys %$a2 ? $a1 : $a2; - foreach my $k (keys %$bigger) { - my $e1 = exists $a1->{$k} ? $a1->{$k} : $DNE; - my $e2 = exists $a2->{$k} ? $a2->{$k} : $DNE; - - push @Data_Stack, { type => 'HASH', idx => $k, vals => [$e1, $e2] }; - $ok = _deep_check($e1, $e2); - pop @Data_Stack if $ok; - - last unless $ok; - } - - return $ok; -} - -#line 1346 - -sub eq_set { - my($a1, $a2) = @_; - return 0 unless @$a1 == @$a2; - - # There's faster ways to do this, but this is easiest. - local $^W = 0; - - # It really doesn't matter how we sort them, as long as both arrays are - # sorted with the same algorithm. - # - # Ensure that references are not accidentally treated the same as a - # string containing the reference. - # - # Have to inline the sort routine due to a threading/sort bug. - # See [rt.cpan.org 6782] - # - # I don't know how references would be sorted so we just don't sort - # them. This means eq_set doesn't really work with refs. - return eq_array( - [grep(ref, @$a1), sort( grep(!ref, @$a1) )], - [grep(ref, @$a2), sort( grep(!ref, @$a2) )], - ); -} - -#line 1534 - -1; diff -Nru /tmp/MQ70iNNc2v/libauthen-sasl-perl-2.12/lib/Authen/SASL/Perl/DIGEST_MD5.pm.orig /tmp/c5NcsEjNyt/libauthen-sasl-perl-2.13/lib/Authen/SASL/Perl/DIGEST_MD5.pm.orig --- libauthen-sasl-perl-2.12/lib/Authen/SASL/Perl/DIGEST_MD5.pm.orig 1970-01-01 01:00:00.000000000 +0100 +++ libauthen-sasl-perl-2.13/lib/Authen/SASL/Perl/DIGEST_MD5.pm.orig 2009-09-24 04:04:08.000000000 +0100 @@ -0,0 +1,401 @@ +# Copyright (c) 2003-2005 Graham Barr, Djamel Boudjerda, Paul Connolly, Julian Onions and Nexor. +# All rights reserved. This program is free software; you can redistribute +# it and/or modify it under the same terms as Perl itself. + +# See http://www.ietf.org/rfc/rfc2831.txt for details + +package Authen::SASL::Perl::DIGEST_MD5; + +use strict; +use vars qw($VERSION @ISA $CNONCE); +use Digest::MD5 qw(md5_hex md5); +use Digest::HMAC_MD5 qw(hmac_md5); + +$VERSION = "1.06"; +@ISA = qw(Authen::SASL::Perl); + +my %secflags = ( + noplaintext => 1, + noanonymous => 1, +); + +# some have to be quoted - some don't - sigh! +my %qdval; @qdval{qw(username authzid realm nonce cnonce digest-uri)} = (); + +my %multi; @multi{qw(realm auth-param)} = (); +my @required = qw(algorithm nonce); + +# we use indices to deal with layer calculations internally +my @layertypes = (undef, 'auth', 'auth-int', 'auth-conf'); + +sub _order { 3 } +sub _secflags { + shift; + scalar grep { $secflags{$_} } @_; +} + +sub mechanism { 'DIGEST-MD5' } + +sub _init { + my ($pkg, $self) = @_; + bless $self, $pkg; + + # set default security properties + $self->property('minssf', 0); + $self->property('maxssf', int 2**31 - 1); # XXX - arbitrary "high" value + $self->property('maxbuf', 0xFFFFFF); # maximum supported by GSSAPI mech + $self->property('externalssf', 0); + $self; +} + +# no initial value passed to the server +sub client_start { + my $self = shift; + + $self->{state} = 0; + $self->{layer} = undef; + $self->{sndseqnum} = 0; + $self->{rcvseqnum} = 0; + + # reset properties for new session + $self->property(maxout => undef); + $self->property(ssf => undef); + ''; +} + +sub client_step { # $self, $server_sasl_credentials + my ($self, $challenge) = @_; + $self->{server_params} = \my %sparams; + + # Parse response parameters + while($challenge =~ s/^(?:\s*,)*\s*(\w+)=("([^\\"]+|\\.)*"|[^,]+)\s*(?:,\s*)*//) { + my ($k, $v) = ($1,$2); + if ($v =~ /^"(.*)"$/s) { + ($v = $1) =~ s/\\(.)/$1/g; + } + if (exists $multi{$k}) { + my $aref = $sparams{$k} ||= []; + push @$aref, $v; + } + elsif (defined $sparams{$k}) { + return $self->set_error("Bad challenge: '$challenge'"); + } + else { + $sparams{$k} = $v; + } + } + + return $self->set_error("Bad challenge: '$challenge'") + if length $challenge; + + if ($self->{state} == 1) { + + # check server's `rspauth' response + return $self->set_error("Server did not send rspauth in step 2") + unless ($sparams{rspauth}); + return $self->set_error("Invalid rspauth in step 2") + unless ($self->{rspauth} eq $sparams{rspauth}); + + # all is well + return ''; + } + + # check required fields in server challenge + if (my @missing = grep { !exists $sparams{$_} } @required) { + return $self->set_error("Server did not provide required field(s): @missing") + } + + my %response = ( + nonce => $sparams{'nonce'}, + cnonce => md5_hex($CNONCE || join (":", $$, time, rand)), + 'digest-uri' => $self->service . '/' . $self->host, + # calc how often the server nonce has been seen; server expects "00000001" + nc => sprintf("%08d", ++$self->{nonce}{$sparams{'nonce'}}), + charset => $sparams{'charset'}, + ); + + # calculate qop + return $self->set_error("Server qop too weak (qop = $sparams{'qop'})") + unless ($self->{layer} = $self->_layer($sparams{qop})); + + $response{qop} = $layertypes[$self->{layer}]; + + # let caller-provided fields override defaults: authorization ID, service name, realm + + my $s_realm = $sparams{realm} || []; + my $realm = $self->_call('realm', @$s_realm); + unless (defined $realm) { + # If the user does not pick a realm, use the first from the server + $realm = $s_realm->[0]; + } + if (defined $realm) { + $response{realm} = $realm; + } + + my $authzid = $self->_call('authname'); + if (defined $authzid) { + $response{authzid} = $authzid; + } + + my $serv_name = $self->_call('serv'); + if (defined $serv_name) { + $response{'digest-uri'} .= '/' . $serv_name; + } + + my $user = $self->_call('user'); + return $self->set_error("Username is required") + unless defined $user; + $response{username} = $user; + + my $password = $self->_call('pass'); + return $self->set_error("Password is required") + unless defined $password; + + $self->property('maxout',$sparams{server_maxbuf} || 65536); + $self->property('ssf',$self->{layer}-1) if ($self->{layer}); + + # Generate the response value + $self->{state} = 1; + + $realm = "" unless defined $realm; + my $A1 = join (":", + md5(join (":", $user, $realm, $password)), + @response{defined($authzid) ? qw(nonce cnonce authzid) : qw(nonce cnonce)} + ); + + # pre-compute MD5(A1) and HEX(MD5(A1)); these are used multiple times below + my $hdA1 = unpack("H*",(my $dA1 = md5($A1))); + + # derive keys for layer encryption / integrity + $self->{kic} = md5($dA1, + 'Digest session key to client-to-server signing key magic constant'); + + $self->{kis} = md5($dA1, + 'Digest session key to server-to-client signing key magic constant'); + +# no encryption support yet +# $self->{kcc} = md5($dA1, +# 'Digest H(A1) key to client-to-server signing key magic constant'); +# +# $self->{kcs} = md5($dA1, +# 'Digest H(A1) key to server-to-client signing key magic constant'); + + my $A2 = "AUTHENTICATE:" . $response{'digest-uri'}; + $A2 .= ":00000000000000000000000000000000" if ($self->{layer} > 1); + + $response{'response'} = md5_hex( + join (":", $hdA1, @response{qw(nonce nc cnonce qop)}, md5_hex($A2)) + ); + + # calculate server `rspauth' response, so we can check in step 2 + # the only difference here is in the A2 string which from which + # `AUTHENTICATE' is omitted in the calculation of `rspauth' + $A2 = ":" . $response{'digest-uri'}; + $A2 .= ":00000000000000000000000000000000" if ($self->{layer} > 1); + + $self->{rspauth} = md5_hex( + join (":", $hdA1, @response{qw(nonce nc cnonce qop)}, md5_hex($A2)) + ); + + # finally, return our response token + join (",", map { _qdval($_, $response{$_}) } sort keys %response); +} + +sub _qdval { + my ($k, $v) = @_; + + if (!defined $v) { + return; + } + elsif (exists $qdval{$k}) { + $v =~ s/([\\"])/\\$1/g; + return qq{$k="$v"}; + } + + return "$k=$v"; +} + +sub _layer { + my ($self, $sqop) = @_; + + # construct server qop mask + # qop in server challenge is optional: if not there "auth" is assumed + my $smask = 0; + map { + m/^auth$/ and $smask |= 1; + m/^auth-int$/ and $smask |= 2; + m/^auth-conf$/ and $smask |= 4; + } split(/,/, $sqop || 'auth'); + + # construct our qop mask + my $cmask = 0; + my $maxssf = $self->property('maxssf') - $self->property('externalssf'); + $maxssf = 0 if ($maxssf < 0); + my $minssf = $self->property('minssf') - $self->property('externalssf'); + $minssf = 0 if ($minssf < 0); + + return undef if ($maxssf < $minssf); # sanity check + + # ssf values > 1 mean integrity and confidentiality + # ssf == 1 means integrity but no confidentiality + # ssf < 1 means neither integrity nor confidentiality + # no security layer can be had if buffer size is 0 + $cmask |= 1 if ($minssf < 1); + $cmask |= 2 if ($minssf <= 1 and $maxssf >= 1); + +# no encryption support yet +# $cmask |= 4 if ($maxssf > 1); + + + # find common bits + $cmask &= $smask; + + return 4 if ($cmask & 4); + return 2 if ($cmask & 2); + return 1 if ($cmask & 1); + + return undef; +} + + +sub encode { # input: self, plaintext buffer,length (length not used here) + my $self = shift; + my $seqnum = pack('N', $self->{sndseqnum}++); + my $mac = substr(hmac_md5($seqnum . $_[0], $self->{kic}), 0, 10); + return $_[0] . $mac . pack('n', 1) . $seqnum; +} + +sub decode { # input: self, cipher buffer,length + my ($self, $buf, $len) = @_; + return if ($len <= 16); + + my ($mac, $type, $seqnum) = unpack('a[10]na[4]', substr($buf, -16, 16, '')); + my $check = substr(hmac_md5($seqnum . $buf, $self->{kis}), 0, 10); + return if ($mac ne $check); + return if (unpack('N', $seqnum) != $self->{rcvseqnum}); + $self->{rcvseqnum}++; + + return $buf; +} + +1; + +__END__ + +=head1 NAME + +Authen::SASL::Perl::DIGEST_MD5 - Digest MD5 Authentication class + +=head1 SYNOPSIS + + use Authen::SASL qw(Perl); + + $sasl = Authen::SASL->new( + mechanism => 'DIGEST-MD5', + callback => { + user => $user, + pass => $pass, + serv => $serv + }, + ); + +=head1 DESCRIPTION + +This method implements the client part of the DIGEST-MD5 SASL algorithm, +as described in RFC 2831. + +This module only implements the I operation which offers authentication +but neither integrity protection not encryption. + +=head2 CALLBACK + +The callbacks used are: + +=over 4 + +=item authname + +The authorization id to use after successful authentication + +=item user + +The username to be used in the response + +=item pass + +The password to be used in the response + +=item serv + +The service name when authenticating to a replicated service + +=item realm + +The authentication realm when overriding the server-provided default. +If not given the server-provided value is used. + +The callback will be passed the list of realms that the server provided +in the initial response. + +=back + +=head2 PROPERTIES + +The properties used are: + +=over 4 + +=item maxbuf + +The maximum buffer size for receiving cipher text + +=item minssf + +The minimum SSF value that should be provided by the SASL security layer. +The default is 0 + +=item maxssf + +The maximum SSF value that should be provided by the SASL security layer. +The default is 2**31 + +=item externalssf + +The SSF value provided by an underlying external security layer. +The default is 0 + +=item ssf + +The actual SSF value provided by the SASL security layer after the SASL +authentication phase has been completed. This value is read-only and set +by the implementation after the SASL authentication phase has been completed. + +=item maxout + +The maximum plaintext buffer size for sending data to the peer. +This value is set by the implementation after the SASL authentication +phase has been completed and a SASL security layer is in effect. + +=back + + +=head1 SEE ALSO + +L, +L + +=head1 AUTHORS + +Graham Barr, Djamel Boudjerda (NEXOR), Paul Connolly, Julian Onions (NEXOR) + +Please report any bugs, or post any suggestions, to the perl-ldap mailing list + + +=head1 COPYRIGHT + +Copyright (c) 2003-2005 Graham Barr, Djamel Boudjerda, Paul Connolly, +Julian Onions, Nexor and Peter Marschall. +All rights reserved. This program is free software; you can redistribute +it and/or modify it under the same terms as Perl itself. + +=cut diff -Nru /tmp/MQ70iNNc2v/libauthen-sasl-perl-2.12/lib/Authen/SASL/Perl/DIGEST_MD5.pm.rej /tmp/c5NcsEjNyt/libauthen-sasl-perl-2.13/lib/Authen/SASL/Perl/DIGEST_MD5.pm.rej --- libauthen-sasl-perl-2.12/lib/Authen/SASL/Perl/DIGEST_MD5.pm.rej 1970-01-01 01:00:00.000000000 +0100 +++ libauthen-sasl-perl-2.13/lib/Authen/SASL/Perl/DIGEST_MD5.pm.rej 2009-09-24 04:05:48.000000000 +0100 @@ -0,0 +1,77 @@ +*************** +*** 88,100 **** + return $self->set_error("Bad challenge: '$challenge'") + if length $challenge; + + # qop in server challenge is optional: if not there "auth" is assumed + return $self->set_error("Server does not support auth (qop = $sparams{'qop'})") + if ($sparams{qop} && ! grep { /^auth$/ } split(/,/, $sparams{'qop'})); + +- # check required fields in server challenge + if (my @missing = grep { !exists $sparams{$_} } @required) { +- return $self->set_error("Server did not provide required field(s): @missing") + } + + my %response = ( +--- 89,126 ---- + return $self->set_error("Bad challenge: '$challenge'") + if length $challenge; + ++ $self->{challenge_count} += 1; ++ + # qop in server challenge is optional: if not there "auth" is assumed + return $self->set_error("Server does not support auth (qop = $sparams{'qop'})") + if ($sparams{qop} && ! grep { /^auth$/ } split(/,/, $sparams{'qop'})); + ++ # check required fields in server challenge, but only on first iteration + if (my @missing = grep { !exists $sparams{$_} } @required) { ++ if ($self->{challenge_count} < 2) { ++ return $self->set_error("Server did not provide required field(s): @missing") ++ } ++ } ++ ++ if ($self->{challenge_count} > 2) { ++ return $self->set_error("Too many challenge iterations for DIGEST-MD5"); ++ } ++ if ($self->{challenge_count} == 2) { ++ unless (exists $sparams{'rspauth'}) { ++ return $self->set_error("Missing second stage rspauth data"); ++ } ++ foreach my $k ('digest_uri', 'response_prefix') { ++ unless (exists $self->{$k}) { ++ return $self->set_error("Lost our $k field"); ++ } ++ } ++ my $step3_A2 = ':' . $self->{'digest_uri'}; ++ # If supporting protection layers, there's an extra field here ++ my $step3 = md5_hex($self->{'response_prefix'} . md5_hex($step3_A2)); ++ if ($sparams{'rspauth'} ne $step3) { ++ return $self->set_error("Server failed final verification."); ++ } ++ return ''; + } + + my %response = ( +*************** +*** 151,159 **** + $A2 .= ":00000000000000000000000000000000" + if $response{'qop'} and $response{'qop'} =~ /^auth-(conf|int)$/; + +- $response{'response'} = md5_hex( +- join (":", md5_hex($A1), @response{qw(nonce nc cnonce qop)}, md5_hex($A2)) +- ); + + join (",", map { _qdval($_, $response{$_}) } sort keys %response); + } +--- 177,187 ---- + $A2 .= ":00000000000000000000000000000000" + if $response{'qop'} and $response{'qop'} =~ /^auth-(conf|int)$/; + ++ my $response_prefix = join (":", md5_hex($A1), @response{qw(nonce nc cnonce qop)}, ''); ++ $response{'response'} = md5_hex($response_prefix . md5_hex($A2)); ++ ++ $self->{digest_uri} = $response{'digest-uri'}; ++ $self->{response_prefix} = $response_prefix; + + join (",", map { _qdval($_, $response{$_}) } sort keys %response); + } diff -Nru /tmp/MQ70iNNc2v/libauthen-sasl-perl-2.12/lib/Authen/SASL/Perl/EXTERNAL.pm /tmp/c5NcsEjNyt/libauthen-sasl-perl-2.13/lib/Authen/SASL/Perl/EXTERNAL.pm --- libauthen-sasl-perl-2.12/lib/Authen/SASL/Perl/EXTERNAL.pm 2008-07-01 03:57:02.000000000 +0100 +++ libauthen-sasl-perl-2.13/lib/Authen/SASL/Perl/EXTERNAL.pm 2009-09-24 23:26:50.000000000 +0100 @@ -8,12 +8,13 @@ use strict; use vars qw($VERSION @ISA); -$VERSION = "1.03"; +$VERSION = "1.04"; @ISA = qw(Authen::SASL::Perl); my %secflags = ( noplaintext => 1, nodictionary => 1, + noanonymous => 1, ); sub _order { 2 } @@ -25,12 +26,14 @@ sub mechanism { 'EXTERNAL' } sub client_start { - '' + my $self = shift; + my $v = $self->_call('user'); + defined($v) ? $v : '' } -sub client_step { - shift->_call('user'); -} +#sub client_step { +# shift->_call('user'); +#} 1; diff -Nru /tmp/MQ70iNNc2v/libauthen-sasl-perl-2.12/lib/Authen/SASL/Perl/EXTERNAL.pm.orig /tmp/c5NcsEjNyt/libauthen-sasl-perl-2.13/lib/Authen/SASL/Perl/EXTERNAL.pm.orig --- libauthen-sasl-perl-2.12/lib/Authen/SASL/Perl/EXTERNAL.pm.orig 1970-01-01 01:00:00.000000000 +0100 +++ libauthen-sasl-perl-2.13/lib/Authen/SASL/Perl/EXTERNAL.pm.orig 2008-06-30 14:22:29.000000000 +0100 @@ -0,0 +1,94 @@ +# Copyright (c) 1998-2002 Graham Barr and 2001 Chris Ridd +# . 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::EXTERNAL; + +use strict; +use vars qw($VERSION @ISA); + +$VERSION = "1.03"; +@ISA = qw(Authen::SASL::Perl); + +my %secflags = ( + noplaintext => 1, + nodictionary => 1, +); + +sub _order { 2 } +sub _secflags { + shift; + grep { $secflags{$_} } @_; +} + +sub mechanism { 'EXTERNAL' } + +sub client_start { + '' +} + +sub client_step { + shift->_call('user'); +} + +1; + +__END__ + +=head1 NAME + +Authen::SASL::Perl::EXTERNAL - External Authentication class + +=head1 SYNOPSIS + + use Authen::SASL qw(Perl); + + $sasl = Authen::SASL->new( + mechanism => 'EXTERNAL', + callback => { + user => $user + }, + ); + +=head1 DESCRIPTION + +This method implements the client part of the EXTERNAL SASL algorithm, +as described in RFC 2222. + +=head2 CALLBACK + +The callbacks used are: + +=over 4 + +=item user + +The username to be used for authentication + +=back + +=head1 SEE ALSO + +L, +L + +=head1 AUTHORS + +Software written by Graham Barr , +documentation written by Peter Marschall . + +Please report any bugs, or post any suggestions, to the perl-ldap mailing list + + +=head1 COPYRIGHT + +Copyright (c) 1998-2004 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. + +Documentation Copyright (c) 2004 Peter Marschall. +All rights reserved. This documentation is distributed, +and may be redistributed, under the same terms as Perl itself. + +=cut diff -Nru /tmp/MQ70iNNc2v/libauthen-sasl-perl-2.12/lib/Authen/SASL/Perl/GSSAPI.pm /tmp/c5NcsEjNyt/libauthen-sasl-perl-2.13/lib/Authen/SASL/Perl/GSSAPI.pm --- libauthen-sasl-perl-2.12/lib/Authen/SASL/Perl/GSSAPI.pm 2008-07-01 03:57:02.000000000 +0100 +++ libauthen-sasl-perl-2.13/lib/Authen/SASL/Perl/GSSAPI.pm 2009-09-24 23:33:37.000000000 +0100 @@ -9,7 +9,7 @@ use vars qw($VERSION @ISA); use GSSAPI; -$VERSION= "0.04"; +$VERSION= "0.05"; @ISA = qw(Authen::SASL::Perl); my %secflags = ( @@ -57,7 +57,8 @@ $self->{gss_ctx} = new GSSAPI::Context; $self->{gss_state} = 0; $self->{gss_layer} = undef; - $self->{gss_cred} = $self->_call('pass') || GSS_C_NO_CREDENTIAL; + my $cred = $self->_call('pass'); + $self->{gss_cred} = (ref($cred) && $cred->isa('GSSAPI::Cred')) ? $cred : GSS_C_NO_CREDENTIAL; $self->{gss_mech} = $self->_call('gssmech') || gss_mech_krb5; # reset properties for new session @@ -251,7 +252,7 @@ security layer following authentication. Unless the connection is protected by other means, such as TLS, it will be vulnerable to man-in-the-middle attacks. If security layers are required, then the -Authen::SASL::Cyrus GSSAPI module should be used instead. +L GSSAPI module should be used instead. =head2 CALLBACK diff -Nru /tmp/MQ70iNNc2v/libauthen-sasl-perl-2.12/lib/Authen/SASL.pm /tmp/c5NcsEjNyt/libauthen-sasl-perl-2.13/lib/Authen/SASL.pm --- libauthen-sasl-perl-2.12/lib/Authen/SASL.pm 2008-07-01 03:57:02.000000000 +0100 +++ libauthen-sasl-perl-2.13/lib/Authen/SASL.pm 2009-09-24 23:26:50.000000000 +0100 @@ -8,9 +8,10 @@ use vars qw($VERSION @Plugins); use Carp; -$VERSION = "2.12"; +$VERSION = "2.13"; @Plugins = qw( + Authen::SASL::XS Authen::SASL::Cyrus Authen::SASL::Perl ); @@ -70,24 +71,32 @@ sub client_new { # $self, $service, $host, $secflags my $self = shift; + my $err; foreach my $pkg (@Plugins) { if (eval "require $pkg" and $pkg->can("client_new")) { - return ($self->{conn} = $pkg->client_new($self, @_)); + if ($self->{conn} = eval { $pkg->client_new($self, @_) }) { + return $self->{conn}; + } + $err = $@; } } - croak "Cannot find a SASL Connection library"; + croak $err || "Cannot find a SASL Connection library"; } sub server_new { # $self, $service, $host, $secflags my $self = shift; + my $err; foreach my $pkg (@Plugins) { if (eval "require $pkg" and $pkg->can("server_new")) { - return ($self->{conn} = $pkg->server_new($self, @_)); + if ($self->{conn} = eval { $pkg->server_new($self, @_) } ) { + return $self->{conn}; + } + $err = $@; } } - croak "Cannot find a SASL Connection library for server-side authentication"; + croak $err || "Cannot find a SASL Connection library for server-side authentication"; } sub error { diff -Nru /tmp/MQ70iNNc2v/libauthen-sasl-perl-2.12/lib/Authen/SASL.pod /tmp/c5NcsEjNyt/libauthen-sasl-perl-2.13/lib/Authen/SASL.pod --- libauthen-sasl-perl-2.12/lib/Authen/SASL.pod 2008-07-01 03:57:02.000000000 +0100 +++ libauthen-sasl-perl-2.13/lib/Authen/SASL.pod 2009-09-24 05:17:11.000000000 +0100 @@ -32,15 +32,20 @@ This module implements several mechanisms and is implemented entirely in Perl. -=item Authen::SASL::Cyrus +=item Authen::SASL::XS This module uses the Cyrus SASL C-library (both version 1 and 2 are supported). +=item Authen::SASL::Cyrus + +This module is the predecessor to L. It is reccomended +to use L + =back By default the order in which these plugins are selected is -Authen::SASL::Cyrus first and then Authen::SASL::Perl. +Authen::SASL::XS, Authen::SASL::Cyrus and then Authen::SASL::Perl. If you want to change it or want to specifically use one implementation only simply do @@ -120,7 +125,6 @@ =item server_new ( SERVICE, HOST ) Creates and returns a new connection object for a server-side connection. -Currently only supported by L. =item error ( ) @@ -209,8 +213,7 @@ =head1 SEE ALSO -L, L (for more methods that currently -only support by Authen::SASL::Cyrus) +L, L, L =head1 AUTHOR diff -Nru /tmp/MQ70iNNc2v/libauthen-sasl-perl-2.12/Makefile.PL /tmp/c5NcsEjNyt/libauthen-sasl-perl-2.13/Makefile.PL --- libauthen-sasl-perl-2.12/Makefile.PL 2008-07-01 03:57:02.000000000 +0100 +++ libauthen-sasl-perl-2.13/Makefile.PL 2009-09-24 04:25:56.000000000 +0100 @@ -1,54 +1,22 @@ # This -*- perl -*- script makes the Makefile +use strict; +use warnings; use 5.005; use inc::Module::Install; -name ('Authen-SASL'); -abstract ('SASL Authentication framework'); -author ('Graham Barr '); -version_from ('lib/Authen/SASL.pm'); -license ('perl'); -repository ('git://git.goingon.net/Authen-SASL.git'); - -check_nmake(); # check and download nmake.exe for Win32 - -perl_version 5.005; - -include_deps ('Test::More'); -include ('ExtUtils::AutoInstall'); - -features( - 'DIGEST-MD5 mechanism' => [ - -default => 1, - 'Digest::MD5' => 0, - 'Digest::HMAC_MD5' => 0, - ], - 'CRAM-MD5 mechanism' => [ - -default => 0, - 'Digest::HMAC_MD5' => 0, - ], - 'GSSAPI mechanism' => [ - -default => 0, - 'GSSAPI' => 0, - ], -); - -auto_install_now(); - -&Makefile->write; -&Meta->write; - -## - - - - - - - - - -sub MY::postamble { - return <<'POSTAMBLE'; - -distdir : manifest run_cpansign - -run_cpansign : - cpansign -s - -POSTAMBLE - -} +name 'Authen-SASL'; +abstract 'SASL Authentication framework'; +author 'Graham Barr '; +version_from 'lib/Authen/SASL.pm'; +license 'perl'; +repository 'http://github.com/gbarr/perl-authen-sasl'; + +perl_version 5.005; + +test_requires 'Test::More' => 0; +requires 'Digest::MD5' => 0; +requires 'Digest::HMAC_MD5' => 0; +recommends 'GSSAPI' => 0; +WriteAll(); diff -Nru /tmp/MQ70iNNc2v/libauthen-sasl-perl-2.12/MANIFEST /tmp/c5NcsEjNyt/libauthen-sasl-perl-2.13/MANIFEST --- libauthen-sasl-perl-2.12/MANIFEST 2008-07-01 03:57:02.000000000 +0100 +++ libauthen-sasl-perl-2.13/MANIFEST 2009-09-24 23:35:08.000000000 +0100 @@ -1,22 +1,15 @@ -.gitignore api.txt Changes compat_pl example_pl -inc/attributes.pm -inc/Module/AutoInstall.pm inc/Module/Install.pm -inc/Module/Install/AutoInstall.pm inc/Module/Install/Base.pm inc/Module/Install/Can.pm inc/Module/Install/Fetch.pm -inc/Module/Install/Include.pm inc/Module/Install/Makefile.pm inc/Module/Install/Metadata.pm inc/Module/Install/Win32.pm -inc/Test/Builder.pm -inc/Test/Builder/Module.pm -inc/Test/More.pm +inc/Module/Install/WriteAll.pm lib/Authen/SASL.pm lib/Authen/SASL.pod lib/Authen/SASL/CRAM_MD5.pm @@ -26,12 +19,16 @@ lib/Authen/SASL/Perl/ANONYMOUS.pm lib/Authen/SASL/Perl/CRAM_MD5.pm lib/Authen/SASL/Perl/DIGEST_MD5.pm +lib/Authen/SASL/Perl/DIGEST_MD5.pm.orig +lib/Authen/SASL/Perl/DIGEST_MD5.pm.rej lib/Authen/SASL/Perl/EXTERNAL.pm +lib/Authen/SASL/Perl/EXTERNAL.pm.orig lib/Authen/SASL/Perl/GSSAPI.pm lib/Authen/SASL/Perl/LOGIN.pm lib/Authen/SASL/Perl/PLAIN.pm Makefile.PL -MANIFEST +MANIFEST This list of files +MANIFEST.SKIP META.yml SIGNATURE t/anon.t diff -Nru /tmp/MQ70iNNc2v/libauthen-sasl-perl-2.12/MANIFEST.SKIP /tmp/c5NcsEjNyt/libauthen-sasl-perl-2.13/MANIFEST.SKIP --- libauthen-sasl-perl-2.12/MANIFEST.SKIP 1970-01-01 01:00:00.000000000 +0100 +++ libauthen-sasl-perl-2.13/MANIFEST.SKIP 2009-09-24 04:25:56.000000000 +0100 @@ -0,0 +1,23 @@ +^_build +^Build$ +^blib +~$ +\.bak$ +\.DS_Store +cover_db +\..*\.sw.?$ +^Makefile$ +^pm_to_blib$ +^MakeMaker-\d +^blibdirs$ +\.old$ +^#.*#$ +^\.# +^TODO$ +^PLANS$ +^doc/ +^benchmarks +^\._.*$ +\.shipit +^Authen-SASL-* +\.git.* diff -Nru /tmp/MQ70iNNc2v/libauthen-sasl-perl-2.12/META.yml /tmp/c5NcsEjNyt/libauthen-sasl-perl-2.13/META.yml --- libauthen-sasl-perl-2.12/META.yml 2008-07-01 03:57:02.000000000 +0100 +++ libauthen-sasl-perl-2.13/META.yml 2009-09-24 23:35:08.000000000 +0100 @@ -2,21 +2,29 @@ abstract: 'SASL Authentication framework' author: - 'Graham Barr ' +build_requires: + ExtUtils::MakeMaker: 6.42 + Test::More: 0 configure_requires: - ExtUtils::MakeMaker: 6.30 + ExtUtils::MakeMaker: 6.42 distribution_type: module -generated_by: 'Module::Install version 0.75' +generated_by: 'Module::Install version 0.91' license: perl meta-spec: - url: http://module-build.sourceforge.net/META-spec-v1.3.html - version: 1.3 + url: http://module-build.sourceforge.net/META-spec-v1.4.html + version: 1.4 name: Authen-SASL no_index: directory: - inc - t +recommends: + GSSAPI: 0 requires: + Digest::HMAC_MD5: 0 + Digest::MD5: 0 perl: 5.005 resources: - repository: git://git.goingon.net/Authen-SASL.git -version: 2.12 + license: http://dev.perl.org/licenses/ + repository: http://github.com/gbarr/perl-authen-sasl +version: 2.13 diff -Nru /tmp/MQ70iNNc2v/libauthen-sasl-perl-2.12/SIGNATURE /tmp/c5NcsEjNyt/libauthen-sasl-perl-2.13/SIGNATURE --- libauthen-sasl-perl-2.12/SIGNATURE 2008-07-01 03:57:02.000000000 +0100 +++ libauthen-sasl-perl-2.13/SIGNATURE 2009-09-24 23:35:10.000000000 +0100 @@ -14,30 +14,24 @@ -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA1 -SHA1 4c48401da9c997e33bfe5b6d2f0f8ec65a19b99c .gitignore -SHA1 ed040f32b0b798b956b5ef15624b13497e91af06 Changes -SHA1 7a03dacaaebee023467d9013ef6e5165c88cab20 MANIFEST -SHA1 05bcd8f2d0886c6f99f6a8220b64889cbd1791ee META.yml -SHA1 cee71efffc41b2b3304ff2bf2f7a872631644587 Makefile.PL +SHA1 f15ac041fa3e071c3b9acad505c2f88c5e997567 Changes +SHA1 8deaad291303021f706d68b655109b9adbace3bb MANIFEST +SHA1 76ce2a83a03713855f54e0f0f13093bab0f5de6d MANIFEST.SKIP +SHA1 6547788e1bf08a293967cbc12ef97f28a25044d2 META.yml +SHA1 365b708be4553d5f9d64cc6d06a15067aea5af18 Makefile.PL SHA1 5f0157764b661d07d362fc64f5a5a81a0b064974 api.txt SHA1 81644069dc4507a71e4cfeef20780fee6c7ee00a compat_pl SHA1 fe659c6b2d6041f944072b9aa1e4ff3a49381e36 example_pl -SHA1 603bb9de29fb8cba7f13409c546750972eff645d inc/Module/AutoInstall.pm -SHA1 f0577f8f88a6703e9bca2d10196cfd293f3d6f2f inc/Module/Install.pm -SHA1 b2a2c9b6cb4b1bcd119825acc707f45946d8b126 inc/Module/Install/AutoInstall.pm -SHA1 5d574849849860b8cf06035cc6f1a306c66cb326 inc/Module/Install/Base.pm -SHA1 c30f50bc2a1542dff17f84a54d9316f3c3c6299e inc/Module/Install/Can.pm -SHA1 9b618efcd783f6ed4bab84fa22b31886fcc38d57 inc/Module/Install/Fetch.pm -SHA1 808d4b2d764185a34c89e675bb4eaad18c075b14 inc/Module/Install/Include.pm -SHA1 cd14c8de2a67b0f14df9bc20c27f3edabd359d1b inc/Module/Install/Makefile.pm -SHA1 a2162aec678d21988fce47ab805cf01773196292 inc/Module/Install/Metadata.pm -SHA1 4ae5d56e11e640bd9520634dde6d563926f6d98a inc/Module/Install/Win32.pm -SHA1 f0ebc594cf8ba858ee9a840c344d9b7ea2c3c6f4 inc/Test/Builder.pm -SHA1 6bb30e9867f6dbcada80acca07cb727fa09fc3a0 inc/Test/Builder/Module.pm -SHA1 07c750f370de7a44ee7b0ed9ec30a7e89c24c9b9 inc/Test/More.pm -SHA1 a3b43f30a4aa19adb8cda1ceaf5b19da0a5e1cae inc/attributes.pm -SHA1 9827bb81880f2e2322009e31e26e4d187202d535 lib/Authen/SASL.pm -SHA1 a7a6cb2b7f4fe90ec980aed61802fe4e345e5288 lib/Authen/SASL.pod +SHA1 fd5f3c4f0418efee3b9b16cf8c3902e8374909df inc/Module/Install.pm +SHA1 7cd7c349afdf3f012e475507b1017bdfa796bfbd inc/Module/Install/Base.pm +SHA1 ba186541bbf6439111f01fc70769cf24d22869bf inc/Module/Install/Can.pm +SHA1 aaa50eca0d7751db7a4d953fac9bc72c6294e238 inc/Module/Install/Fetch.pm +SHA1 3e83972921d54198d1246f7278f08664006cd65d inc/Module/Install/Makefile.pm +SHA1 12bf1867955480d47d5171a9e9c6a96fabe0b58f inc/Module/Install/Metadata.pm +SHA1 f7ee667e878bd2faf22ee9358a7b5a2cc8e91ba4 inc/Module/Install/Win32.pm +SHA1 8ed29d6cf217e0977469575d788599cbfb53a5ca inc/Module/Install/WriteAll.pm +SHA1 202c9952dd3a867a981f090f41f9b6ebc011e316 lib/Authen/SASL.pm +SHA1 905932edff6fdd5e598cd7cb842e15056625f154 lib/Authen/SASL.pod SHA1 76c9a0b3e6ba6201a0e84eb13ce51c1b81df5008 lib/Authen/SASL/CRAM_MD5.pm SHA1 ec5ca70880db07636a7c8b576460f1b86d5729bb lib/Authen/SASL/EXTERNAL.pm SHA1 98868b8a5d4c7d574353cb62251026feda5cf007 lib/Authen/SASL/Perl.pm @@ -45,8 +39,11 @@ SHA1 8fc746203af4e4447b3d1344153bd8f8fa4c568b lib/Authen/SASL/Perl/ANONYMOUS.pm SHA1 d1dbf799365c42c1bd8f8083a2a1dde0da541bcf lib/Authen/SASL/Perl/CRAM_MD5.pm SHA1 169f56765be6b4aa5c596b078da7d3885d69d344 lib/Authen/SASL/Perl/DIGEST_MD5.pm -SHA1 2bbac374513b11a9e0b8e90fc16fc9d09e05baff lib/Authen/SASL/Perl/EXTERNAL.pm -SHA1 6a27f432bf6d694043befffce9453a4b2203b84a lib/Authen/SASL/Perl/GSSAPI.pm +SHA1 724a0ce9c43636d383071733abff8281d3eae84f lib/Authen/SASL/Perl/DIGEST_MD5.pm.orig +SHA1 288a006a036a9d43db894159dbc3b260a4de194d lib/Authen/SASL/Perl/DIGEST_MD5.pm.rej +SHA1 ec8d602f2c5de0437abfcc9a81232599e35cbe95 lib/Authen/SASL/Perl/EXTERNAL.pm +SHA1 2bbac374513b11a9e0b8e90fc16fc9d09e05baff lib/Authen/SASL/Perl/EXTERNAL.pm.orig +SHA1 7c9facb2f8b81c430d1fd530a634e8cfc67e33f6 lib/Authen/SASL/Perl/GSSAPI.pm SHA1 63f1286d46e6a5b59e7c74d0f048d10beda55939 lib/Authen/SASL/Perl/LOGIN.pm SHA1 68a91cc6ec6f9afb4493eab87b82e714728bdc29 lib/Authen/SASL/Perl/PLAIN.pm SHA1 be0c439da3f8f1740fa8b623cee9662946a62c3f t/anon.t @@ -54,14 +51,14 @@ SHA1 b638f32f3215163b607c509a55026bafa5c5edfc t/cram_md5.t SHA1 06807509ff341e48a01c4260f64a1e7b17b4c7eb t/digest_md5.t SHA1 7a52a9574b75c55d663de86edaf6b64d5f2a5814 t/digest_md5_verified.t -SHA1 d3ccc7e4331dd867d6af39c8fde420b33afd21a1 t/external.t +SHA1 c539103a4d2db98a95cfe2064822f58c153a14d4 t/external.t SHA1 5ee2d46cf9db2d059fb0e6525cd92493e4e0fe65 t/login.t SHA1 6a6c9fa037cdaf24091524cc399f9cc799547732 t/order.t SHA1 0c80dacffa7e1ae386ae6023f58a5562433e3587 t/plain.t -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.9 (Darwin) -iEYEARECAAYFAkhpnKEACgkQR0BL4gbYw3R/MQCfcRNoySXPwAvkgXzrLJc+r0xz -1YkAn3K3uZbn4CdbQyAFYftYloML2Xhz -=1TlS +iEYEARECAAYFAkq79BwACgkQR0BL4gbYw3Q4GgCfYezbMhRknM4Ig4Jxuhy7Lf+i +nNIAn2UFAhngHFi0quPiiKssOFN3G5jW +=dSKI -----END PGP SIGNATURE----- diff -Nru /tmp/MQ70iNNc2v/libauthen-sasl-perl-2.12/t/external.t /tmp/c5NcsEjNyt/libauthen-sasl-perl-2.13/t/external.t --- libauthen-sasl-perl-2.12/t/external.t 2008-07-01 03:57:02.000000000 +0100 +++ libauthen-sasl-perl-2.13/t/external.t 2009-09-24 23:33:31.000000000 +0100 @@ -20,8 +20,8 @@ is($conn->mechanism, 'EXTERNAL', 'conn mechanism'); -is($conn->client_start, '', 'client_start'); +is($conn->client_start, 'gbarr', 'client_start'); -is($conn->client_step("xyz"), 'gbarr', 'client_step'); +is($conn->client_step("xyz"), undef, 'client_step');