Crypt-Password-0.28/0000755000175000017500000000000011717615137013413 5ustar stevesteveCrypt-Password-0.28/Makefile.PL0000644000175000017500000000130411717615137015363 0ustar stevesteve# # Copyright (C) 2009 NZ Registry Services # # This program is free software: you can redistribute it and/or modify # it under the terms of the Artistic License 2.0 or later. You should # have received a copy of the Artistic License the file COPYING.txt. # If not, see use inc::Module::Install; name ("Crypt-Password"); abstract ("Utilities functions for Unix-style Hashed Passwords"); author ("Catalyst SRS Team "); version_from ("lib/Crypt/Password.pm"); license ('artistic'); requires ("perl" => 5.008005); repository 'http://github.com/st3vil/Crypt-Password'; &WriteAll; Crypt-Password-0.28/CHANGES0000644000175000017500000000404611717615137014412 0ustar stevesteveRevision history for Crypt::Password 0.28 2012-02-18 * windows support * cygwin = windows 0.27 2012-02-16 * some more guesses at cross-platform behaviour 0.26 2012-02-15 * dont feed hash part in as salt, solaris uses too much for salt 0.25 2011-12-23 * some tweaks for windows 0.24 2011-12-21 * fix tests 0.23 2011-12-20 * test refactoring * thinking more in terms of extended, modular and... windows * throw away overloading/external OO, add check_password($crypted, $plain) 0.22 2011-12-15 * less experimenting 0.21 2011-12-15 * tidy ups, blowfish = 2 * dont croak ourselves on unknown algorithms 0.20 2011-12-12 * make a new isnt 0.19 2011-12-11 * freebsd Extended format experimentation * done re-add algorithm id to dollary salt 0.18 2011-12-10 * freebsd dollarsing to include salt, empty salt * experiment with lots of algorithms * freebsd seems to like alg 1/5/6 not 2 0.17 2011-12-10 * work around weird unoverloading bug? in Test::More * experimental windows support 0.16 2011-12-09 * variabullo 0.15 2011-12-08 * some more freebsd understanding 0.14 2011-12-07 * actually change the crypt_flav when testing variations * return a definite string value to avoid this "isn't numeric is string ne" 0.12 2011-12-04 * misc/other 0.11 2011-12-02 * nothing 0.10 2011-12-01 * debug stuff for cpantesters * half-support some underunderstood crypt implementations 0.09 2011-11-29 * fix infinite recursion bug so *BSDs return actual broken test results 0.08 2011-11-23 * half-supporting more crypt implementations, release for cpantesters 0.07 2011-11-14 * doc edits * replace the somehow-deleted inc/Module/Install... 0.06 2011-11-12 * FreeSec (darwin, BSD) support * warning labels in docs about not definitely crypting * add crypt_password for definitely crypting something 0.05 2010-04-24 * rewrite without Moose 0.04 2009-10-17 * test fixes; avoid isnt(), plan once 0.03 2009-10-16 * compat woe; test salt lengths 1-16 and diag throughout 0.02 2009-10-13 * improve tests * add known issue about not working on Darwin 0.01 2009-10-07 * initial revision Crypt-Password-0.28/inc/0000755000175000017500000000000011717615137014164 5ustar stevesteveCrypt-Password-0.28/inc/Module/0000755000175000017500000000000011717615137015411 5ustar stevesteveCrypt-Password-0.28/inc/Module/Install/0000755000175000017500000000000011717615137017017 5ustar stevesteveCrypt-Password-0.28/inc/Module/Install/Makefile.pm0000644000175000017500000001600311717615137021072 0ustar stevesteve#line 1 package Module::Install::Makefile; use strict 'vars'; use ExtUtils::MakeMaker (); use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '0.91'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub Makefile { $_[0] } my %seen = (); sub prompt { shift; # Infinite loop protection my @c = caller(); if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) { die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])"; } # In automated testing, always use defaults if ( $ENV{AUTOMATED_TESTING} and ! $ENV{PERL_MM_USE_DEFAULT} ) { local $ENV{PERL_MM_USE_DEFAULT} = 1; goto &ExtUtils::MakeMaker::prompt; } else { goto &ExtUtils::MakeMaker::prompt; } } sub makemaker_args { my $self = shift; my $args = ( $self->{makemaker_args} ||= {} ); %$args = ( %$args, @_ ); return $args; } # For mm args that take multiple space-seperated args, # append an argument to the current list. sub makemaker_append { my $self = sShift; my $name = shift; my $args = $self->makemaker_args; $args->{name} = defined $args->{$name} ? join( ' ', $args->{name}, @_ ) : join( ' ', @_ ); } sub build_subdirs { my $self = shift; my $subdirs = $self->makemaker_args->{DIR} ||= []; for my $subdir (@_) { push @$subdirs, $subdir; } } sub clean_files { my $self = shift; my $clean = $self->makemaker_args->{clean} ||= {}; %$clean = ( %$clean, FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_), ); } sub realclean_files { my $self = shift; my $realclean = $self->makemaker_args->{realclean} ||= {}; %$realclean = ( %$realclean, FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_), ); } sub libs { my $self = shift; my $libs = ref $_[0] ? shift : [ shift ]; $self->makemaker_args( LIBS => $libs ); } sub inc { my $self = shift; $self->makemaker_args( INC => shift ); } my %test_dir = (); sub _wanted_t { /\.t$/ and -f $_ and $test_dir{$File::Find::dir} = 1; } sub tests_recursive { my $self = shift; if ( $self->tests ) { die "tests_recursive will not work if tests are already defined"; } my $dir = shift || 't'; unless ( -d $dir ) { die "tests_recursive dir '$dir' does not exist"; } %test_dir = (); require File::Find; File::Find::find( \&_wanted_t, $dir ); $self->tests( join ' ', map { "$_/*.t" } sort keys %test_dir ); } sub write { my $self = shift; die "&Makefile->write() takes no arguments\n" if @_; # 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; 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; $args->{VERSION} = $self->version; $args->{NAME} =~ s/-/::/g; if ( $self->tests ) { $args->{test} = { TESTS => $self->tests }; } if ( $] >= 5.005 ) { $args->{ABSTRACT} = $self->abstract; $args->{AUTHOR} = $self->author; } if ( eval($ExtUtils::MakeMaker::VERSION) >= 6.10 ) { $args->{NO_META} = 1; } if ( eval($ExtUtils::MakeMaker::VERSION) > 6.17 and $self->sign ) { $args->{SIGN} = 1; } unless ( $self->is_admin ) { delete $args->{SIGN}; } # Merge both kinds of requires into prereq_pm my $prereq = ($args->{PREREQ_PM} ||= {}); %$prereq = ( %$prereq, map { @$_ } map { @$_ } grep $_, ($self->configure_requires, $self->build_requires, $self->requires) ); # Remove any reference to perl, PREREQ_PM doesn't support it delete $args->{PREREQ_PM}->{perl}; # merge both kinds of requires into prereq_pm my $subdirs = ($args->{DIR} ||= []); if ($self->bundles) { foreach my $bundle (@{ $self->bundles }) { my ($file, $dir) = @$bundle; push @$subdirs, $dir if -d $dir; delete $prereq->{$file}; } } if ( my $perl_version = $self->perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; } $args->{INSTALLDIRS} = $self->installdirs; my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_})} keys %$args; my $user_preop = delete $args{dist}->{PREOP}; if (my $preop = $self->admin->preop($user_preop)) { foreach my $key ( keys %$preop ) { $args{dist}->{$key} = $preop->{$key}; } } my $mm = ExtUtils::MakeMaker::WriteMakefile(%args); $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile'); } sub fix_up_makefile { my $self = shift; my $makefile_name = shift; my $top_class = ref($self->_top) || ''; my $top_version = $self->_top->VERSION || ''; my $preamble = $self->preamble ? "# Preamble by $top_class $top_version\n" . $self->preamble : ''; my $postamble = "# Postamble by $top_class $top_version\n" . ($self->postamble || ''); local *MAKEFILE; open MAKEFILE, "< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; my $makefile = do { local $/; }; close MAKEFILE or die $!; $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /; $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g; $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g; $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m; $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m; # Module::Install will never be used to build the Core Perl # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m; #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m; # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well. $makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g; # XXX - This is currently unused; not sure if it breaks other MM-users # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg; open MAKEFILE, "> $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; print MAKEFILE "$preamble$makefile$postamble" or die $!; close MAKEFILE or die $!; 1; } sub preamble { my ($self, $text) = @_; $self->{preamble} = $text . $self->{preamble} if defined $text; $self->{preamble}; } sub postamble { my ($self, $text) = @_; $self->{postamble} ||= $self->admin->postamble; $self->{postamble} .= $text if defined $text; $self->{postamble} } 1; __END__ #line 394 Crypt-Password-0.28/inc/Module/Install/Metadata.pm0000644000175000017500000003530411717615137021102 0ustar stevesteve#line 1 package Module::Install::Metadata; use strict 'vars'; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '0.91'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } my @boolean_keys = qw{ sign }; my @scalar_keys = qw{ name module_name abstract author version distribution_type tests installdirs }; my @tuple_keys = qw{ configure_requires build_requires requires recommends bundles resources }; 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 ( @boolean_keys ) { *$key = sub { my $self = shift; if ( defined wantarray and not @_ ) { return $self->{values}->{$key}; } $self->{values}->{$key} = ( @_ ? $_[0] : 1 ); return $self; }; } foreach my $key ( @scalar_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} = shift; return $self; }; } 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; }; } 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; }; } 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 $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}; } # 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(@_) } # 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 dynamic_config { my $self = shift; unless ( @_ ) { warn "You MUST provide an explicit true/false value to dynamic_config\n"; 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" ); $file = join('/', 'lib', split(/-/, $name)) . '.pm'; $file =~ s{.*/}{} 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. # If there is a matching .pod, use that instead my $pod = $file; $pod =~ s/\.pm$/.pod/i; $pod = $file unless -e $pod; # Pull the different values $self->name_from($file) unless $self->name; $self->version_from($file) unless $self->version; $self->perl_version_from($file) unless $self->perl_version; $self->author_from($pod) unless $self->author; $self->license_from($pod) unless $self->license; $self->abstract_from($pod) unless $self->abstract; return 1; } sub provides { my $self = shift; my $provides = ( $self->{values}->{provides} ||= {} ); %$provides = (%$provides, @_) if @_; return $provides; } sub auto_provides { my $self = shift; return $self unless $self->is_admin; unless (-e 'MANIFEST') { warn "Cannot deduce auto_provides without a MANIFEST, skipping\n"; return $self; } # Avoid spurious warnings as we are not checking manifest here. local $SIG{__WARN__} = sub {1}; require ExtUtils::Manifest; local *ExtUtils::Manifest::manicheck = sub { return }; require Module::Build; my $build = Module::Build->new( dist_name => $self->name, dist_version => $self->version, license => $self->license, ); $self->provides( %{ $build->find_dist_packages || {} } ); } sub feature { my $self = shift; my $name = shift; my $features = ( $self->{values}->{features} ||= [] ); my $mods; if ( @_ == 1 and ref( $_[0] ) ) { # The user used ->feature like ->features by passing in the second # argument as a reference. Accomodate for that. $mods = $_[0]; } else { $mods = \@_; } my $count = 0; push @$features, ( $name => [ map { ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_ } @$mods ] ); return @$features; } sub features { my $self = shift; while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) { $self->feature( $name, @$mods ); } return $self->{values}->{features} ? @{ $self->{values}->{features} } : (); } sub no_index { my $self = shift; my $type = shift; push @{ $self->{values}->{no_index}->{$type} }, @_ if $type; return $self->{values}->{no_index}; } sub read { my $self = shift; $self->include_deps( 'YAML::Tiny', 0 ); require YAML::Tiny; my $data = YAML::Tiny::LoadFile('META.yml'); # Call methods explicitly in case user has already set some values. while ( my ( $key, $value ) = each %$data ) { next unless $self->can($key); if ( ref $value eq 'HASH' ) { while ( my ( $module, $version ) = each %$value ) { $self->can($key)->($self, $module => $version ); } } else { $self->can($key)->($self, $value); } } return $self; } sub write { my $self = shift; return $self unless $self->is_admin; $self->admin->write_meta; return $self; } sub version_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->version( ExtUtils::MM_Unix->parse_version($file) ); } sub abstract_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->abstract( bless( { DISTNAME => $self->name }, 'ExtUtils::MM_Unix' )->parse_abstract($file) ); } # Add both distribution and module name sub name_from { my ($self, $file) = @_; if ( Module::Install::_read($file) =~ m/ ^ \s* package \s* ([\w:]+) \s* ; /ixms ) { my ($name, $module_name) = ($1, $1); $name =~ s{::}{-}g; $self->name($name); unless ( $self->module_name ) { $self->module_name($module_name); } } else { die("Cannot determine name from $file\n"); } } sub perl_version_from { my $self = shift; if ( Module::Install::_read($_[0]) =~ m/ ^ (?:use|require) \s* v? ([\d_\.]+) \s* ; /ixms ) { my $perl_version = $1; $perl_version =~ s{_}{}g; $self->perl_version($perl_version); } else { warn "Cannot determine perl version info from $_[0]\n"; return; } } sub author_from { my $self = shift; my $content = Module::Install::_read($_[0]); if ($content =~ m/ =head \d \s+ (?:authors?)\b \s* ([^\n]*) | =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s* .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s* ([^\n]*) /ixms) { my $author = $1 || $2; $author =~ s{E}{<}g; $author =~ s{E}{>}g; $self->author($author); } else { warn "Cannot determine author info from $_[0]\n"; } } sub license_from { my $self = shift; if ( Module::Install::_read($_[0]) =~ m/ ( =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b .*? ) (=head\\d.*|=cut.*|) \z /ixms ) { my $license_text = $1; my @phrases = ( '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 ) { $self->license($license); return 1; } } } warn "Cannot determine license info from $_[0]\n"; return 'unknown'; } 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; # 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; Crypt-Password-0.28/inc/Module/Install/Can.pm0000644000175000017500000000333311717615137020060 0ustar stevesteve#line 1 package Module::Install::Can; use strict; use Config (); use File::Spec (); use ExtUtils::MakeMaker (); use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '0.91'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # check if we can load some module ### Upgrade this to not have to load the module if possible sub can_use { my ($self, $mod, $ver) = @_; $mod =~ s{::|\\}{/}g; $mod .= '.pm' unless $mod =~ /\.pm$/i; my $pkg = $mod; $pkg =~ s{/}{::}g; $pkg =~ s{\.pm$}{}i; local $@; eval { require $mod; $pkg->VERSION($ver || 0); 1 }; } # check if we can run some command sub can_run { my ($self, $cmd) = @_; my $_cmd = $cmd; 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)); } return; } # can we locate a (the) C compiler sub can_cc { my $self = shift; my @chunks = split(/ /, $Config::Config{cc}) or return; # $Config{cc} may contain args; try to find out the program part while (@chunks) { return $self->can_run("@chunks") || (pop(@chunks), next); } return; } # Fix Cygwin bug on maybe_command(); if ( $^O eq 'cygwin' ) { require ExtUtils::MM_Cygwin; require ExtUtils::MM_Win32; if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) { *ExtUtils::MM_Cygwin::maybe_command = sub { my ($self, $file) = @_; if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) { ExtUtils::MM_Win32->maybe_command($file); } else { ExtUtils::MM_Unix->maybe_command($file); } } } } 1; __END__ #line 156 Crypt-Password-0.28/inc/Module/Install/Base.pm0000644000175000017500000000176611717615137020241 0ustar stevesteve#line 1 package Module::Install::Base; use strict 'vars'; use vars qw{$VERSION}; BEGIN { $VERSION = '0.91'; } # Suspend handler for "redefined" warnings BEGIN { my $w = $SIG{__WARN__}; $SIG{__WARN__} = sub { $w }; } #line 42 sub new { 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 { local $@; my $func = eval { shift->_top->autoload } or return; goto &$func; } #line 75 sub _top { $_[0]->{_top}; } #line 90 sub admin { $_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new; } #line 106 sub is_admin { $_[0]->admin->VERSION; } sub DESTROY {} package Module::Install::Base::FakeAdmin; my $fake; sub new { $fake ||= bless(\@_, $_[0]); } sub AUTOLOAD {} sub DESTROY {} # Restore warning handler BEGIN { $SIG{__WARN__} = $SIG{__WARN__}->(); } 1; #line 154 Crypt-Password-0.28/inc/Module/Install/Fetch.pm0000644000175000017500000000462711717615137020417 0ustar stevesteve#line 1 package Module::Install::Fetch; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '0.91'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub get_file { my ($self, %args) = @_; 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) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; } $|++; print "Fetching '$file' from $host... "; unless (eval { require Socket; Socket::inet_aton($host) }) { warn "'$host' resolve failed!\n"; return; } return unless $scheme eq 'ftp' or $scheme eq 'http'; require Cwd; my $dir = Cwd::getcwd(); chdir $args{local_dir} or return if exists $args{local_dir}; if (eval { require LWP::Simple; 1 }) { LWP::Simple::mirror($args{url}, $file); } elsif (eval { require Net::FTP; 1 }) { eval { # use Net::FTP to get past firewall my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600); $ftp->login("anonymous", 'anonymous@example.com'); $ftp->cwd($path); $ftp->binary; $ftp->get($file) or (warn("$!\n"), return); $ftp->quit; } } elsif (my $ftp = $self->can_run('ftp')) { eval { # no Net::FTP, fallback to ftp.exe require FileHandle; my $fh = FileHandle->new; local $SIG{CHLD} = 'IGNORE'; unless ($fh->open("|$ftp -n")) { warn "Couldn't open ftp: $!\n"; chdir $dir; return; } my @dialog = split(/\n/, <<"END_FTP"); open $host user anonymous anonymous\@example.com cd $path binary get $file $file quit END_FTP foreach (@dialog) { $fh->print("$_\n") } $fh->close; } } else { warn "No working 'ftp' program available!\n"; chdir $dir; return; } unless (-f $file) { warn "Fetching failed: $@\n"; chdir $dir; return; } return if exists $args{size} and -s $file != $args{size}; system($args{run}) if exists $args{run}; unlink($file) if $args{remove}; print(((!exists $args{check_for} or -e $args{check_for}) ? "done!" : "failed! ($!)"), "\n"); chdir $dir; return !$?; } 1; Crypt-Password-0.28/inc/Module/Install/WriteAll.pm0000644000175000017500000000222211717615137021076 0ustar stevesteve#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; Crypt-Password-0.28/inc/Module/Install/Win32.pm0000644000175000017500000000340311717615137020257 0ustar stevesteve#line 1 package Module::Install::Win32; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '0.91'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # determine if the user needs nmake, and download it if needed sub check_nmake { my $self = shift; $self->load('can_run'); $self->load('get_file'); require Config; return unless ( $^O eq 'MSWin32' and $Config::Config{make} and $Config::Config{make} =~ /^nmake\b/i and ! $self->can_run('nmake') ); print "The required 'nmake' executable not found, fetching it...\n"; require File::Basename; my $rv = $self->get_file( url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe', ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe', local_dir => File::Basename::dirname($^X), size => 51928, run => 'Nmake15.exe /o > nul', check_for => 'Nmake.exe', remove => 1, ); die <<'END_MESSAGE' unless $rv; ------------------------------------------------------------------------------- Since you are using Microsoft Windows, you will need the 'nmake' utility before installation. It's available at: http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe or ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe Please download the file manually, save it to a directory in %PATH% (e.g. C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to that directory, and run "Nmake15.exe" from there; that will create the 'nmake.exe' file needed by this module. You may then resume the installation process described in README. ------------------------------------------------------------------------------- END_MESSAGE } 1; Crypt-Password-0.28/inc/Module/Install.pm0000644000175000017500000002411411717615137017357 0ustar stevesteve#line 1 package Module::Install; # For any maintainers: # The load order for Module::Install is a bit magic. # It goes something like this... # # IF ( host has Module::Install installed, creating author mode ) { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install # 3. The installed version of inc::Module::Install loads # 4. inc::Module::Install calls "require Module::Install" # 5. The ./inc/ version of Module::Install loads # } ELSE { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install # 3. The ./inc/ version of Module::Install loads # } use 5.005; use strict 'vars'; 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 # different versions of modules. # 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.91'; # Storage for the pseudo-singleton $MAIN = undef; *inc::Module::Install::VERSION = *VERSION; @inc::Module::Install::ISA = __PACKAGE__; } # Whether or not inc::Module::Install is actually loaded, the # $INC{inc/Module/Install.pm} is what will still get set as long as # the caller loaded module this in the documented manner. # If not set, the caller may NOT have loaded the bundled version, and thus # they may not have a MI version that works with the Makefile.PL. This would # result in false errors or unexpected behaviour. And we don't want that. my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm'; unless ( $INC{$file} ) { die <<"END_DIE" } Please invoke ${\__PACKAGE__} with: use inc::${\__PACKAGE__}; not: use ${\__PACKAGE__}; END_DIE # If the script that is loading Module::Install is from the future, # then make will detect this and cause it to re-run over and over # 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 ) { my $s = (stat($0))[9]; # 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 } # Build.PL was formerly supported, but no longer is due to excessive # difficulty in implementing every single feature twice. if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" } Module::Install no longer supports Build.PL. It was impossible to maintain duel backends, and has been deprecated. Please remove all Build.PL files and only use the Makefile.PL installer. END_DIE # To save some more typing in Module::Install installers, every... # use inc::Module::Install # ...also acts as an implicit use strict. $^H |= strict::bits(qw(refs subs vars)); use Cwd (); use File::Find (); use File::Path (); use FindBin; sub autoload { my $self = shift; my $who = $self->_caller; my $cwd = Cwd::cwd(); my $sym = "${who}::AUTOLOAD"; $sym->{$cwd} = sub { my $pwd = Cwd::cwd(); if ( my $code = $sym->{$pwd} ) { # 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')}; }; } sub import { my $class = shift; my $self = $class->new(@_); my $who = $self->_caller; unless ( -f $self->{file} ) { require "$self->{path}/$self->{dispatch}.pm"; File::Path::mkpath("$self->{prefix}/$self->{author}"); $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self ); $self->{admin}->init; @_ = ($class, _self => $self); goto &{"$self->{name}::import"}; } *{"${who}::AUTOLOAD"} = $self->autoload; $self->preload; # Unregister loader and worker packages so subdirs can use them again delete $INC{"$self->{file}"}; delete $INC{"$self->{path}.pm"}; # Save to the singleton $MAIN = $self; return 1; } sub preload { my $self = shift; unless ( $self->{extensions} ) { $self->load_extensions( "$self->{prefix}/$self->{path}", $self ); } my @exts = @{$self->{extensions}}; unless ( @exts ) { @exts = $self->{admin}->load_all_extensions; } my %seen; foreach my $obj ( @exts ) { while (my ($method, $glob) = each %{ref($obj) . '::'}) { next unless $obj->can($method); next if $method =~ /^_/; next if $method eq uc($method); $seen{$method}++; } } my $who = $self->_caller; foreach my $name ( sort keys %seen ) { *{"${who}::$name"} = sub { ${"${who}::AUTOLOAD"} = "${who}::$name"; goto &{"${who}::AUTOLOAD"}; }; } } sub new { my ($class, %args) = @_; # ignore the prefix on extension modules built from top level. my $base_path = Cwd::abs_path($FindBin::Bin); unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) { delete $args{prefix}; } return $args{_self} if $args{_self}; $args{dispatch} ||= 'Admin'; $args{prefix} ||= 'inc'; $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author'); $args{bundle} ||= 'inc/BUNDLES'; $args{base} ||= $base_path; $class =~ s/^\Q$args{prefix}\E:://; $args{name} ||= $class; $args{version} ||= $class->VERSION; unless ( $args{path} ) { $args{path} = $args{name}; $args{path} =~ s!::!/!g; } $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm"; $args{wrote} = 0; bless( \%args, $class ); } sub call { my ($self, $method) = @_; my $obj = $self->load($method) or return; splice(@_, 0, 2, $obj); goto &{$obj->can($method)}; } sub load { my ($self, $method) = @_; $self->load_extensions( "$self->{prefix}/$self->{path}", $self ) unless $self->{extensions}; foreach my $obj (@{$self->{extensions}}) { return $obj if $obj->can($method); } my $admin = $self->{admin} or die <<"END_DIE"; The '$method' method does not exist in the '$self->{prefix}' path! Please remove the '$self->{prefix}' directory and run $0 again to load it. END_DIE my $obj = $admin->load($method, 1); push @{$self->{extensions}}, $obj; $obj; } sub load_extensions { my ($self, $path, $top) = @_; unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) { unshift @INC, $self->{prefix}; } foreach my $rv ( $self->find_extensions($path) ) { my ($file, $pkg) = @{$rv}; next if $self->{pathnames}{$pkg}; local $@; my $new = eval { require $file; $pkg->can('new') }; unless ( $new ) { warn $@ if $@; next; } $self->{pathnames}{$pkg} = delete $INC{$file}; push @{$self->{extensions}}, &{$new}($pkg, _top => $top ); } $self->{extensions} ||= []; } sub find_extensions { my ($self, $path) = @_; my @found; File::Find::find( sub { my $file = $File::Find::name; return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is; my $subpath = $1; return if lc($subpath) eq lc($self->{dispatch}); $file = "$self->{path}/$subpath.pm"; my $pkg = "$self->{name}::$subpath"; $pkg =~ s!/!::!g; # If we have a mixed-case package name, assume case has been preserved # correctly. Otherwise, root through the file to locate the case-preserved # version of the package name. if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) { my $content = Module::Install::_read($subpath . '.pm'); my $in_pod = 0; foreach ( split //, $content ) { $in_pod = 1 if /^=\w/; $in_pod = 0 if /^=cut/; next if ($in_pod || /^=cut/); # skip pod text next if /^\s*#/; # and comments if ( m/^\s*package\s+($pkg)\s*;/i ) { $pkg = $1; last; } } } push @found, [ $file, $pkg ]; }, $path ) if -d $path; @found; } ##################################################################### # Common Utility Functions sub _caller { my $depth = 0; my $call = caller($depth); while ( $call eq __PACKAGE__ ) { $depth++; $call = caller($depth); } return $call; } sub _read { local *FH; 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 $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; 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]): $!"; } # _version is for processing module versions (eg, 1.03_05) not # Perl versions (eg, 5.8.1). sub _version ($) { my $s = shift || 0; 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; 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 - 2009 Adam Kennedy. Crypt-Password-0.28/README0000644000175000017500000000204711717615137014276 0ustar stevesteveREADME for Crypt::Password ========================== This is just a wrapper for perl's crypt(), which can do everything you would probably want to do to store a password, but this is supposed to provide the various uses easier. Installing ---------- The application is designed to be installed like a CPAN module; so use the usual: perl Makefile.PL make sudo make install The CPAN module dependencies will be highlighted during the first command. If you do not have 'sudo' installed, you can use: su root -c make install License and credits ------------------- This software development is sponsored and directed by New Zealand Registry Services, http://www.nzrs.net.nz/ The work is being carried out by Catalyst IT, http://www.catalyst.net.nz/ Copyright (c) 2009, NZ Registry Services. All Rights Reserved. This software may be used under the terms of the Artistic License 2.0. Note that this license is compatible with both the GNU GPL and Artistic licenses. A copy of this license is supplied with the distribution in the file COPYING.txt. Crypt-Password-0.28/t/0000755000175000017500000000000011717615137013656 5ustar stevesteveCrypt-Password-0.28/t/93-perltidy.t0000644000175000017500000000146211717615137016133 0ustar stevesteve#!/usr/bin/perl -w # # t/93-perltidy.t - test whitespace conformance using perltidy # # Copyright (C) 2009 NZ Registry Services # # This program is free software: you can redistribute it and/or modify # it under the terms of the Artistic License 2.0 or later. You should # have received a copy of the Artistic License the file COPYING.txt. # If not, see use strict; use Test::More; use FindBin qw($Bin); plan skip_all => 'set TEST_TIDY or TEST_ALL to enable this test' unless $ENV{TEST_TIDY} or $ENV{TEST_ALL}; my $perltidy = "$Bin/../perltidy.pl"; plan skip_all => 'no perltidy.pl script; run this from a git clone' unless -x $perltidy; plan "no_plan"; my $output = qx($perltidy -t); my $rc = $?; ok( !$rc, "all files tidy" ); diag($output) if $rc; Crypt-Password-0.28/t/92-license.t0000644000175000017500000000206511717615137015720 0ustar stevesteve#!/usr/bin/perl -w use strict; use Test::More; plan skip_all => 'set TEST_LICENSE or TEST_ALL to enable this test' unless $ENV{TEST_LICENSE} or $ENV{TEST_ALL}; plan "no_plan"; use FindBin qw($Bin); use File::Find; find( sub { if (m{\.(pm|pl|t)$}) { open FILE, "<", $_ or die $!; while () { m{Copyright} && do { pass( "$File::Find::name mentions Copyright" ); return; }; } close FILE; fail("$File::Find::name missing license text"); } }, $Bin, "$Bin/../lib" ); # Copyright (C) 2007 Sam Vilain # # This program is free software: you can redistribute it and/or modify # it under the terms of the Artistic License 2.0 or later. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # Artistic License 2.0 for more details. # # You should have received a copy of the Artistic License the file # COPYING.txt. If not, see # Crypt-Password-0.28/t/01-crypt-password.t0000644000175000017500000001321711717615137017266 0ustar stevesteve#!/usr/bin/perl use strict; use warnings; use Test::More 'no_plan'; use FindBin '$Bin'; use lib "$Bin/../lib"; use_ok "Crypt::Password"; $Crypt::Password::TESTMODE = 1; sub mock { bless {@_}, "Crypt::Password" }; no warnings 'once', 'redefine'; my $flav = $Crypt::Password::crypt_flav; diag "testing Crypt::Password (crypt_flav='$flav')"; diag "os is '$^O'"; unless ($flav eq "windows") { my $line = (`man crypt`)[-1]; $line =~ s/\s+/ /g; diag "bottom line of man crypt: '$line'"; } diag "generate salt"; { my %uniq = map { mock()->salt() => undef } 1..20; is scalar(keys %uniq), 20, "random salts generated"; my %uniq2 = map { password("hello") => undef } 1..20; is scalar(keys %uniq2), 20, "randomly salted hashes"; } if ($flav eq "windows") { password("wintest", "_testtest"); password("wintest", "_testbluh"); password("wintest", "_aestbluh"); password("wintest", "_aestblu"); password("wintest", "_aestblu"); password("wintest", "_aestbla"); password('wintest', '$$'); password('wintest', '$a'); password('wintest', '$aetc'); password('wintest', ',hello'); } my $special; $special->{extended} = sub { diag "extended special"; is(password('$_blahblah$2ZtvPvnOO/w'), '$_blahblah$2ZtvPvnOO/w', "crypted string embodied"); is(password("007", "blahblah"), '$_blahblah$2ZtvPvnOO/w', "crypts") for 1..3; is(password("007", "BLAHblah"), '$_BLAHblah$Y8YHRJXwFLE', "crypts with different salt") for 1..3; is(password("123", "_12341234"), '$_12341234$zPVAQUxtWss', "salt can start with _") for 1..2; is(password("a", "cc"), '$cc$IxmriBVsviU', "two character salt") for 1..3; ok(check_password('$_DADAdada$LASg2sXIXlI', "hello0"), "check_password"); ok(!check_password('$_DADAdada$LASg2sXIXlI', "hello1"), "check_password incorrect"); ok(!check_password('$_zzzzzzzz$LASg2sXIXlI', "hello0"), "check_password incorrect"); if ($flav ne "windows") { diag "remake some known crypts"; my @answers = map {[ split /\s+/, $_ ]} split /\n/, <<'ANSWERS'; ambiente $_12345555$V4oENXvTMYk $gi$CZewZaJV4pk lampshade $_12345555$JacsOKd1xTo $gi$zi7R25ah3Zw guitar $_12345555$2yFp.wqJEF. $gi$4tl8fx6Anh. ANSWERS for my $row (@answers) { is(password($row->[0], "12345555"), $row->[1], "test $row->[0] salt=8"); is(password($row->[0], "gi"), $row->[2], "test $row->[0] salt=2"); } diag "various salt inputs"; # all invalid for my $salt ("dgdb", "a", "123456", "1234567", "123456789") { eval { password("hello0", $salt) }; like $@, qr/Bad salt input.+2 or 8 characters/, "wrong sized salt"; $@ = ""; } for my $salt ("_a", "_bb") { eval { password("hello0", "_a") }; like $@, qr/Bad salt input.+2-character salt cannot start with _/, "can't start with _"; $@ = ""; } my $p; eval { $p = password('a', 'bbbbbbbb') }; is $@, "", "salt=8 no error"; is $p, '$_bbbbbbbb$DJEHexiq9NI', "salt=8 crypt"; $@ = ""; } }; $special->{modular} = sub { diag "modular special"; my $c = password("hello0"); like $c, qr/^\$5\$(........)\$[a-zA-Z0-9\.\/]{43}$/, "crypted"; my $c2 = password("hello0"); like $c2, qr/^\$5\$(........)\$[a-zA-Z0-9\.\/]{43}$/, "another crypted"; isnt $c, $c2, "generated different salts"; $DB::single = 1; ok(check_password($c, "hello0"), "check passed"); ok(check_password($c2, "hello0"), "check passed"); ok(!check_password($c, "helu"), "check failed"); diag "modular special argumentative"; my $c3 = password("password", "salt"); like $c3, qr/^\$5\$salt\$.{43}$/, "Default algorithm, supplied salt"; my $c4 = password("password", "", "md5"); like $c4, qr/^\$1\$\$.{22}$/, "md5, no salt"; my $c5 = password("password", undef, "sha512"); like $c5, qr/^\$6\$(.{8})\$.{86}$/, "sha512, invented salt"; diag "modular special embodiment"; my $password = '$5$%RK2BU%L$aFZd1/4Gpko/sJZ8Oh.ZHg9UvxCjkH1YYoLZI6tw7K8'; is $password, password($password), "password embodied by password()"; isnt $password, crypt_password($password), "force recrypted by crypt_password()"; }; diag "random salts"; { isnt(password("hello"), password("hello"), "different"); } diag "set salts"; { is(password("hello", "1234abcd"), password("hello", "1234abcd"), "salt set - same"); }; diag "pass crypted as salt"; { my $h = password("etcetc"); isnt($h, password("etcetc"), "hash made unique by generated salt"); is($h, password("etcetc", $h), "hash passed as salt, regenerates the same hash"); } diag "cant just pass crypted stuff into check_password"; { my $h = password('etcetc', 'blahblah'); isnt(check_password($h, $h), "faile"); } if ($flav eq "windows") { my $p; eval { $p = password('a', 'cc') }; is $@, "", "salt=2 no error"; is $p, '$cc$DFDkLhMbQ7wZ.', "salt=2 crypt"; $@ = ""; } elsif ($flav eq "glib" || $flav eq "freebsd") { $special->{modular}->(); experiment("freesec", "extended"); } else { $special->{extended}->(); experiment("glib", "modular"); } sub experiment { my ($flav, $other) = @_; diag "experimenting in $other with $flav..."; no warnings; *isnt = sub { $_[0] ne $_[1] || diag "'$_[0]' ne '$_[1]' FAIL $_[2]" }; *is = sub { $_[0] eq $_[1] || diag "'$_[0]' eq '$_[1]' FAIL $_[2]" }; *like = sub { $_[0] =~ /$_[1]/ || diag "'$_[0]' =~ '$_[1]' FAIL $_[2]" }; *ok = sub { $_[0] || diag "ok FAIL $_[1]" }; use warnings; local $Crypt::Password::crypt_flav = $flav; eval { $special->{$other}->(); }; diag "errors: $@" if $@; } Crypt-Password-0.28/t/90-pod-syntax.t0000644000175000017500000000111011717615137016370 0ustar stevesteve#!/usr/bin/perl -w # # Copyright (C) 2007 Sam Vilain # # This program is free software: you can redistribute it and/or modify # it under the terms of the Artistic License 2.0 or later. You should # have received a copy of the Artistic License the file COPYING.txt. # If not, see use strict; use warnings; use Test::More; eval "use Test::Pod 1.14"; plan skip_all => 'Test::Pod 1.14 required' if $@; plan skip_all => 'set TEST_POD or TEST_ALL to enable this test' unless $ENV{TEST_POD} or $ENV{TEST_ALL}; all_pod_files_ok(); Crypt-Password-0.28/SubmittingPatches0000644000175000017500000001652511717615137017004 0ustar stevesteveChecklist (and a short version for the impatient): Commits: - make commits of logical units - check for unnecessary whitespace/identation/documentation with "git diff --check" and maintainer tests for each commit - do not check in commented out code or unneeded files - provide a meaningful commit message - the first line of the commit message should be a short description and should skip the full stop - if you want your work included, add a "Signed-off-by: Your Name " line to the commit message (or just use the option "-s" when committing) to confirm that you agree to the Developer's Certificate of Origin (below) - make sure that you have tests for the bug you are fixing - make sure that the test suite passes after your commit Patches: - use "git format-patch -M" to create the patch - send the patch to (srsadmins@catalyst.net.nz) If you use git-send-email(1), please test it first by sending email to yourself. - patches may also be sent to the RT queue for the module on rt.cpan.org; please only create one ticket for each independent change or closely related series of independent changes. Pull requests: - if you use github, use the 'pull request' option and select 'Catalyst' as the recipient. Please do remember to sign-off your changes! ---- Developer's Certificate of Origin 1.2-gnu By making a contribution to this project, I certify that: (a) The contribution was created in whole or in part by me and I have the right to submit it under the license indicated in the file; or (b) The contribution is based upon previous work that, to the best of my knowledge, is covered under an compatible license and I have the right under that license to submit that work with modifications, whether created in whole or in part by me, under the same license (unless I am permitted to submit under a different license), as indicated in the file; or (c) The contribution was provided directly to me by some other person who certified (a), (b) or (c) and I have not modified it. (d) I understand and agree that this project and the contribution are public and that a record of the contribution (including all personal information I submit with it, including my sign-off) is maintained indefinitely and may be redistributed consistent with this project or the license(s) involved. ---- These patch guidelines are intended to help you help us maintain the software. We are interested in all submissions, however we may not have time to make the changes you submit meet the code base standard. Detailed information: (1) Make separate commits for logically separate changes. Unless your patch is really trivial, you should not be sending out a patch that was generated between your working tree and your commit head. Instead, always make a commit with complete commit message and generate a series of patches from your repository. It is a good discipline. Describe the technical detail of the change(s). The guiding principle for change messages is that they should only describe the change that they are making. There should be a little story: 1. why the change must happen (the motivation) 2. what the code used to do, if appropriate (old behaviour) 3. an outline of the new approach, sparing excessive details (new behaviour) They should always be written from the perspective that someone has just run 'git annotate' and landed on this commit; that person has no idea whatsoever about related commits in time. The description should be written in the present tense; with no reference to terms like "this patch". If your description starts to get too long, that's a sign that you probably need to split up your commit to finer grained pieces. (1a) Test your changes Your changes should include tests which demonstrate and hopefully test corner cases of your new additions. If you have difficulty writing these, please submit anyway but tests will help us be sure that your code works and is suitable for inclusion. Ideally, the new tests should fail on the old code, pass on the new code, and test the documented functionality. (1b) Whitespace, indentation, documentation and copyright boilerplate There are tests which check that the indentation matches that which 'perltidy' will produce for the file. Please use them to check that you are conforming to the indentation style of the project. This will involve installing 'perltidy', and setting an environment variable. The style is specifically chosen to allow readers to choose their own tab width setting without breaking the appearance of the code, and to make merging changes easier. In terms of documentation, we also have a rule that all object methods must be documented, or at least mentioned in the SYNOPSIS section of the man page/perldoc for that module. The exception to this is internal functions, which are marked by starting with an underscore. Again, there is a test script for this which only runs with a particular environment variable set. Running the test suite using 'make test' will tell you what you need to set. It is also required that every Perl program contains a brief copyright statement, and there is a test for that too. (1c) Be nice to Perl 5.8.x This codebase is currently designed to run on older perls, ie 5.8.x; though we are likely to soon be making 5.10.0 a minimum requirement. So currently, do not use 5.10+ features such as //-defined-or, smartmatch or newer regex-engine features. We will also endeavour to test the code base on the latest blead and Perl maint branches. (2) Generate your patch using git tools out of your commits. git based diff tools (git, StGIT, etc) generate unidiff which is the preferred format. You do not have to be afraid to use -M option to "git diff" or "git format-patch", if your patch involves file renames. The receiving end can handle them just fine. Please make sure your patch does not include any extra files which do not belong in a patch submission. Make sure to review your patch after generating it, to ensure accuracy. Before sending out, please make sure it cleanly applies to the "master" branch head. If you are preparing a work based on "next" branch, that is fine, but please mark it as such. (3) Agreeing to the DCO The "Sign-off" procedure from git.git and linux-2.6.git is used for this project. This Sign-off indicates _copyright_ conformance only, and is the only strict requirement for submissions. If you are submitting many changes and are worried about potential patent infringement lawsuits, please contact us for a copyright assignment agreement so that we can take formal ownership of your contributions. However this is not necessary for casual submissions, or for those who do not worry about such things. If you want to indicate your change has been reviewed by someone, you can use 'Acked-by:' (4) Sending it in. As there is not currently a mailing list for this program, please submit via one of the following means: * fork the project on github (http://github.com/st3vil/crypt-password) and send a pull request. * Log a ticket at rt.cpan.org under the queue for 'Crypt::Password' (if you must) Crypt-Password-0.28/lib/0000755000175000017500000000000011717615137014161 5ustar stevesteveCrypt-Password-0.28/lib/Crypt/0000755000175000017500000000000011717615137015262 5ustar stevesteveCrypt-Password-0.28/lib/Crypt/Password.pm0000644000175000017500000002741711717615137017435 0ustar stevestevepackage Crypt::Password; use Exporter 'import'; @EXPORT = (qw'password crypt_password check_password'); our $VERSION = "0.28"; our $TESTMODE = 0; use Carp; # from libc6 crypt/crypt-entry.c our %alg_to_id = ( md5 => '1', blowfish => '2', sha256 => '5', sha512 => '6', ); our %id_to_alg = reverse %alg_to_id; # switches off embodying crypted-looking passwords, like crypt_password() our $definitely_crypt; our $crypt_flav = do { $^O =~ /^MSWin|cygwin/ ? 'windows' : do { $_ = (`man crypt`)[-1]; !defined($_) ? 'freesec' : /DragonFly/ ? 'dragonflybsd' : /NetBSD/ ? 'netbsd' : /OpenBSD/ ? 'openbsd' : /FreeBSD/ ? do { /FreeBSD ([\d\.]+)/; # seems 9.0 starts supporting Modular format $1 >= 9 ? 'freebsd' : 'freebsd_lt_9' } : /MirOS/ ? 'windows' : /FreeSec/ ? 'freesec' : 'glib' } }; our $flav_dispatch = { glib => { looks_crypted => sub { return $_[0] =~ m{^\$.+\$.*\$.+$} }, salt_provided => sub { return shift; }, extract_salt => sub { return (split /\$/, $_[0])[2] }, format_crypted => sub { return shift; }, form_salt => sub { my ($s, $self) = @_; unless ($s =~ /^\$.+\$.*(\$.+)?$/) { if ($self->{algorithm_id}) { # put algorithm id in the salt $s =~ s/^/\$$self->{algorithm_id}\$/; } else { # ->check(), alg and salt from ourselves, the rest be ignored $s = "$self"; } } $s = $1 if $s =~ /^(\$.+?\$.+?)\$/; return $s; }, default_algorithm => sub { return "sha256"; }, }, freesec => { # {{{ looks_crypted => sub { # with our dollar-signs added in around the salt return $_[0] =~ /^\$(_.{8}|.{2})\$ (.{11})?$/x }, salt_provided => sub { my $provided = shift; # salt must be 2 or 8 or entropy leaks in around the side # I am serious if ($provided =~ m/^\$(_.{8}|_?.{2})\$(.{11})?$/ || $provided =~ m/^ (_.{8}|_?.{2}) (.{11})?$/x) { $provided = $1; } if ($provided =~ /^_..?$/) { croak "Bad salt input:" ." 2-character salt cannot start with _"; } $provided =~ s/^_//; if ($provided !~ m/^(.{8}|.{2})$/) { croak "Bad salt input:" ." salt must be 2 or 8 characters long"; } return $provided; }, extract_salt => sub { $_[0] =~ /^\$(_.{8}|.{2})\$ (.{11})?$/x; my $s = $1; $s || croak "Bad crypted input:" ." salt must be 2 or 8 characters long"; $s =~ s/^_//; return $s }, format_crypted => sub { my $crypt = shift; # makes pretty ambiguous crypt strings, lets add some dollar signs $crypt =~ s/^(_.{8}|..)(.{11})$/\$$1\$$2/ || croak "failed to understand Extended-format crypt: '$crypt'"; return $crypt; }, form_salt => sub { my ($s) = @_; if (length($s) == 8) { $s = "_$s" } return $s; }, default_algorithm => sub { return "DES" # does nothing }, }, # }}} freebsd_lt_9 => { base => "freesec", }, netbsd => { base => "freebsd_lt_9", }, openbsd => { base => "freebsd_lt_9", }, dragonflybsd => { base => "freebsd_lt_9", }, freebsd => { base => "glib", }, windows => { base => "freesec", looks_crypted => sub { return $_[0] =~ /^\$.+\$.+$/ }, salt_provided => sub { $_[0] =~ /^\$(.+?)\$.+/ ? $1 : $_[0] }, extract_salt => sub { $_[0] =~ /^\$(.+?)\$.+$/; return $1 }, format_crypted => sub { my ($c, $i, $s) = @_; my ($sa, $sb) = $s =~ /^(..)(.+)$/; if ($TESTMODE) { warn "# '$c' ".($c =~ /^$sb(?!$sa)/?"":"!")."= first 2 chars of salt ($s"; } # first two characters of salt is used, it seems $c =~ s/^$sa/\$$s\$/; return $1; }, form_salt => sub { return shift; $_[0] =~ /^(\$|,|_)/ ? $_[0] : "_$_[0]" }, }, }; sub flav { my $func = shift; my $flav = $flav_dispatch->{$crypt_flav} || die; unless (exists $flav->{$func}) { if (exists $flav->{base}) { local $crypt_flav = $flav->{base}; return flav($func, @_); } die "no $func handler for (crypt flavour: $crypt_flav)"; } return $flav->{$func}->(@_); } sub new { shift; password(@_); } sub password { return _password(@_)->{crypted} } sub crypt_password { local $definitely_crypt = 1; return password(@_); } sub check_password { my ($saved, $wild) = @_; return $saved eq crypt_password($wild, $saved); } sub _password { my $self = bless {}, __PACKAGE__; $self->input(shift); unless ($self->{crypted}) { $self->salt(shift); $self->algorithm(shift); $self->crypt(); } $self; } sub crypt { my $self = shift; $self->{crypted} ||= $self->_crypt; return "$self->{crypted}"; } sub input { my $self = shift; $self->{input} = shift; if (!$definitely_crypt && $self->_looks_crypted($self->{input})) { $self->{crypted} = delete $self->{input} } } sub _looks_crypted { my $self = shift; my $string = shift || return; return flav(looks_crypted => $string); } sub salt { my $self = shift; my $provided = shift; if (defined $provided) { $self->{salt} = flav(salt_provided => $provided); } else { return $self->{salt} if defined $self->{salt}; return $self->{salt} = do { if ($self->{crypted}) { return flav(extract_salt => $self->{crypted}); } else { $self->_invent_salt() } }; } } sub algorithm { my $self = shift; $alg = shift; if ($alg) { $alg =~ s/^\$?(.+)\$?$/$1/; if (exists $alg_to_id{lc $alg}) { $self->{algorithm_id} = $alg_to_id{lc $alg}; $self->{algorithm} = lc $alg; } else { # $alg will be passed anyway, it may not be known to %id_to_alg $self->{algorithm_id} = $alg; $self->{algorithm} = $id_to_alg{lc $alg}; } } elsif (!$self->{algorithm}) { $self->algorithm(flav("default_algorithm")); } else { $self->{algorithm} } } sub _crypt { my $self = shift; defined $self->{input} || croak "no input!"; $self->{algorithm_id} || croak "no algorithm!"; defined $self->{salt} || croak "invalid salt!"; my $input = delete $self->{input}; my $salt = $self->_form_salt(); return _do_crypt($input, $salt); } sub _do_crypt { my ($input, $salt) = @_; my $crypt = CORE::crypt($input, $salt); $crypt = flav(format_crypted => $crypt, $input, $salt); warn "# $input $salt = $crypt\n" if $TESTMODE; return $crypt; } sub _form_salt { my $self = shift; my $s = $self->salt; croak "undef salt!?" unless defined $s; return flav(form_salt => $s, $self); } our @valid_salt = ( "/", ".", "a".."z", "A".."Z", "0".."9" ); sub _invent_salt { my $many = $_[1] || 8; join "", map { $valid_salt[rand(@valid_salt)] } 1..$many; } 1; __END__ =head1 NAME Crypt::Password - Unix-style, Variously Hashed Passwords =head1 SYNOPSIS use Crypt::Password; my $hashed = password("plaintext"); $user->set_password($hashed); if (check_password($hash_from_database, $text_from_user)) { # authenticated } my $definitely_crypted_just_then = crypt_password($maybe_already_crypted); # you also might want to password($a) eq password($b) # WARNING: password() will embody but not crypt an already crypted string. # if you are checking something from the outside world, pass both # things to check_password() # imagine stealing a crypted string and using it as a password. it happens. # WARNING: the following applies to glibc's crypt() only # Non-Linux systems beware, see KNOWN ISSUES # Default algorithm, supplied salt: my $hashed = password("password", "salt"); # md5, no salt: my $hashed = password("password", "", "md5"); # sha512, invented salt: my $hashed = password("password", undef, "sha512"); =head1 DESCRIPTION This is just a wrapper for perl's C, which can do everything you would probably want to do to store a password, but this is to make usage easier. The object stringifies to the return string of the crypt() function, which is (on B et al) in Modular Crypt Format: # scalar($hashed): # v digest v hash -> # $5$%RK2BU%L$aFZd1/4Gpko/sJZ8Oh.ZHg9UvxCjkH1YYoLZI6tw7K8 # ^ salt ^ That you can store, etc, retrieve then use it in C to validate a login, etc. Not without some danger, so read on, you could also string compare it to the output of another C, as long as the salt is the same. If you pass a crypted string as the salt it will use the same salt. If the given string is already hashed it is assumed to be okay to use it as is. So if you are checking something from the outside world pass it as the second argument to C. You could also use C, which will definitely crypt its input. This means simpler code and users can supply pre-hashed passwords initially, but if you do it wrong a stolen hash could be used as a password, so buck up your ideas. If you aren't running B, everything after the WARNING in the synopsis is dubious as. If you've got insight into how this module can work better on your platform I would love to hear from you. =head1 FUNCTIONS =over =item password ( $password [, $salt [, $algorithm]] ) Constructs a Crypt::Password object. =item check_password ( $saved_crypt, $wild_password ) Checks that $wild_password is what $saved_crypt was. =item crypt_password ( $password [, $salt [, $algorithm]] ) Same as above but will definitely crypt $password, even if it looks crypted. See warning labels. =back =head1 KNOWN ISSUES Cryptographic functionality depends greatly on your local B. Old Linux may not support sha*, many other platforms only support md5, or that and Blowfish, etc. You are likely fine, but you should run the test suite and read the output carefully. Better still, run your own test suite and you'll know you're okay. Implementations break down into Modular Format and Extended Format. Linux/glib does Modular Format as described in DESCRIPTION, it supports many algorithms, supposedly. FreeSec and most BSDs do Extended Format with the DES algorithm. We modify the output so it's easier to parse again by putting dollar signs in around the salt. The salt must be 2 or 8 characters long, or just 2 on Windows. =head1 SUPPORT, SOURCE If you have a problem, submit a test case via a fork of the github repo. http://github.com/st3vil/Crypt-Password =head1 AUTHOR AND LICENCE Code by Steve Eirium, L, idea by Sam Vilain, L. Development commissioned by NZ Registry Services. Copyright 2009, NZ Registry Services. This module is licensed under the Artistic License v2.0, which permits relicensing under other Free Software licenses. =head1 SEE ALSO L, L, L =cut Crypt-Password-0.28/MANIFEST.SKIP0000644000175000017500000000016711717615137015315 0ustar stevesteve\.bak$ ~$ ^Makefile(.old)?$ ^MANIFEST.SKIP$ #$ ^\.git ^blib/ ^debian/ -stamp$ perltidy.pl \.perltidyrc ^Crypt-Password Crypt-Password-0.28/META.yml0000644000175000017500000000020411717615137014660 0ustar stevesteve--- resources: license: http://opensource.org/licenses/artistic-license.php repository: http://github.com/st3vil/Crypt-Password Crypt-Password-0.28/COPYING.txt0000644000175000017500000002217511717615137015273 0ustar stevesteveArtistic License 2.0 ==================== Copyright (c) 2000-2006, The Perl Foundation. Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble -------- This license establishes the terms under which a given free software Package may be copied, modified, distributed, and/or redistributed. The intent is that the Copyright Holder maintains some artistic control over the development of that Package while still keeping the Package available as open source and free software. You are always permitted to make arrangements wholly outside of this license directly with the Copyright Holder of a given Package. If the terms of this license do not permit the full use that you propose to make of the Package, you should contact the Copyright Holder and seek a different licensing arrangement. Definitions ----------- "Copyright Holder" means the individual(s) or organization(s) named in the copyright notice for the entire Package. "Contributor" means any party that has contributed code or other material to the Package, in accordance with the Copyright Holder's procedures. "You" and "your" means any person who would like to copy, distribute, or modify the Package. "Package" means the collection of files distributed by the Copyright Holder, and derivatives of that collection and/or of those files. A given Package may consist of either the Standard Version, or a Modified Version. "Distribute" means providing a copy of the Package or making it accessible to anyone else, or in the case of a company or organization, to others outside of your company or organization. "Distributor Fee" means any fee that you charge for Distributing this Package or providing support for this Package to another party. It does not mean licensing fees. "Standard Version" refers to the Package if it has not been modified, or has been modified only in ways explicitly requested by the Copyright Holder. "Modified Version" means the Package, if it has been changed, and such changes were not explicitly requested by the Copyright Holder. "Original License" means this Artistic License as Distributed with the Standard Version of the Package, in its current version or as it may be modified by The Perl Foundation in the future. "Source" form means the source code, documentation source, and configuration files for the Package. "Compiled" form means the compiled bytecode, object code, binary, or any other form resulting from mechanical transformation or translation of the Source form. Permission for Use and Modification Without Distribution -------------------------------------------------------- 1. You are permitted to use the Standard Version and create and use Modified Versions for any purpose without restriction, provided that you do not Distribute the Modified Version. Permissions for Redistribution of the Standard Version ------------------------------------------------------ 2. You may Distribute verbatim copies of the Source form of the Standard Version of this Package in any medium without restriction, either gratis or for a Distributor Fee, provided that you duplicate all of the original copyright notices and associated disclaimers. At your discretion, such verbatim copies may or may not include a Compiled form of the Package. 3. You may apply any bug fixes, portability changes, and other modifications made available from the Copyright Holder. The resulting Package will still be considered the Standard Version, and as such will be subject to the Original License. Distribution of Modified Versions of the Package as Source ---------------------------------------------------------- 4. You may Distribute your Modified Version as Source (either gratis or for a Distributor Fee, and with or without a Compiled form of the Modified Version) provided that you clearly document how it differs from the Standard Version, including, but not limited to, documenting any non-standard features, executables, or modules, and provided that you do at least ONE of the following: a. make the Modified Version available to the Copyright Holder of the Standard Version, under the Original License, so that the Copyright Holder may include your modifications in the Standard Version. b. ensure that installation of your Modified Version does not prevent the user installing or running the Standard Version. In addition, the Modified Version must bear a name that is different from the name of the Standard Version. c. allow anyone who receives a copy of the Modified Version to make the Source form of the Modified Version available to others under i. the Original License or ii. a license that permits the licensee to freely copy, modify and redistribute the Modified Version using the same licensing terms that apply to the copy that the licensee received, and requires that the Source form of the Modified Version, and of any works derived from it, be made freely available in that license fees are prohibited but Distributor Fees are allowed. Distribution of Compiled Forms of the Standard Version or Modified Versions without the Source ---------------------------------------------------------------------------------------------- 5. You may Distribute Compiled forms of the Standard Version without the Source, provided that you include complete instructions on how to get the Source of the Standard Version. Such instructions must be valid at the time of your distribution. If these instructions, at any time while you are carrying out such distribution, become invalid, you must provide new instructions on demand or cease further distribution. If you provide valid instructions or cease distribution within thirty days after you become aware that the instructions are invalid, then you do not forfeit any of your rights under this license. 6. You may Distribute a Modified Version in Compiled form without the Source, provided that you comply with Section 4 with respect to the Source of the Modified Version. Aggregating or Linking the Package ---------------------------------- 7. You may aggregate the Package (either the Standard Version or Modified Version) with other packages and Distribute the resulting aggregation provided that you do not charge a licensing fee for the Package. Distributor Fees are permitted, and licensing fees for other components in the aggregation are permitted. The terms of this license apply to the use and distribution of the Standard or Modified Versions as included in the aggregation. 8. You are permitted to link Modified and Standard Versions with other works, to embed the Package in a larger work of your own, or to build stand-alone binary or bytecode versions of applications that include the Package, and Distribute the result without restriction, provided the result does not expose a direct interface to the Package. Items That are Not Considered Part of a Modified Version -------------------------------------------------------- 9. Works (including, but not limited to, modules and scripts) that merely extend or make use of the Package, do not, by themselves, cause the Package to be a Modified Version. In addition, such works are not considered parts of the Package itself, and are not subject to the terms of this license. General Provisions ------------------ 10. Any use, modification, and distribution of the Standard or Modified Versions is governed by this Artistic License. By using, modifying or distributing the Package, you accept this license. Do not use, modify, or distribute the Package, if you do not accept this license. 11. If your Modified Version has been derived from a Modified Version made by someone other than you, you are nevertheless required to ensure that your Modified Version complies with the requirements of this license. 12. This license does not grant you the right to use any trademark, service mark, tradename, or logo of the Copyright Holder. 13. This license includes the non-exclusive, worldwide, free-of-charge patent license to make, have made, use, offer to sell, sell, import and otherwise transfer the Package with respect to any patent claims licensable by the Copyright Holder that are necessarily infringed by the Package. If you institute patent litigation (including a cross-claim or counterclaim) against any party alleging that the Package constitutes direct or contributory patent infringement, then this Artistic License to you shall terminate on the date that such litigation is filed. 14. Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.