Authen-SCRAM-0.011/000755 000765 000024 00000000000 13313601310 014023 5ustar00davidstaff000000 000000 Authen-SCRAM-0.011/devel/000755 000765 000024 00000000000 13313601310 015122 5ustar00davidstaff000000 000000 Authen-SCRAM-0.011/LICENSE000644 000765 000024 00000026354 13313601310 015042 0ustar00davidstaff000000 000000 This software is Copyright (c) 2014 by David Golden. This is free software, licensed under: The Apache License, Version 2.0, January 2004 Apache License Version 2.0, January 2004 http://www.apache.org/licenses/ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 1. Definitions. "License" shall mean the terms and conditions for use, reproduction, and distribution as defined by Sections 1 through 9 of this document. "Licensor" shall mean the copyright owner or entity authorized by the copyright owner that is granting the License. "Legal Entity" shall mean the union of the acting entity and all other entities that control, are controlled by, or are under common control with that entity. For the purposes of this definition, "control" means (i) the power, direct or indirect, to cause the direction or management of such entity, whether by contract or otherwise, or (ii) ownership of fifty percent (50%) or more of the outstanding shares, or (iii) beneficial ownership of such entity. "You" (or "Your") shall mean an individual or Legal Entity exercising permissions granted by this License. "Source" form shall mean the preferred form for making modifications, including but not limited to software source code, documentation source, and configuration files. "Object" form shall mean any form resulting from mechanical transformation or translation of a Source form, including but not limited to compiled object code, generated documentation, and conversions to other media types. "Work" shall mean the work of authorship, whether in Source or Object form, made available under the License, as indicated by a copyright notice that is included in or attached to the work (an example is provided in the Appendix below). "Derivative Works" shall mean any work, whether in Source or Object form, that is based on (or derived from) the Work and for which the editorial revisions, annotations, elaborations, or other modifications represent, as a whole, an original work of authorship. For the purposes of this License, Derivative Works shall not include works that remain separable from, or merely link (or bind by name) to the interfaces of, the Work and Derivative Works thereof. "Contribution" shall mean any work of authorship, including the original version of the Work and any modifications or additions to that Work or Derivative Works thereof, that is intentionally submitted to Licensor for inclusion in the Work by the copyright owner or by an individual or Legal Entity authorized to submit on behalf of the copyright owner. For the purposes of this definition, "submitted" means any form of electronic, verbal, or written communication sent to the Licensor or its representatives, including but not limited to communication on electronic mailing lists, source code control systems, and issue tracking systems that are managed by, or on behalf of, the Licensor for the purpose of discussing and improving the Work, but excluding communication that is conspicuously marked or otherwise designated in writing by the copyright owner as "Not a Contribution." "Contributor" shall mean Licensor and any individual or Legal Entity on behalf of whom a Contribution has been received by Licensor and subsequently incorporated within the Work. 2. Grant of Copyright License. Subject to the terms and conditions of this License, each Contributor hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable copyright license to reproduce, prepare Derivative Works of, publicly display, publicly perform, sublicense, and distribute the Work and such Derivative Works in Source or Object form. 3. Grant of Patent License. Subject to the terms and conditions of this License, each Contributor hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable (except as stated in this section) patent license to make, have made, use, offer to sell, sell, import, and otherwise transfer the Work, where such license applies only to those patent claims licensable by such Contributor that are necessarily infringed by their Contribution(s) alone or by combination of their Contribution(s) with the Work to which such Contribution(s) was submitted. If You institute patent litigation against any entity (including a cross-claim or counterclaim in a lawsuit) alleging that the Work or a Contribution incorporated within the Work constitutes direct or contributory patent infringement, then any patent licenses granted to You under this License for that Work shall terminate as of the date such litigation is filed. 4. Redistribution. You may reproduce and distribute copies of the Work or Derivative Works thereof in any medium, with or without modifications, and in Source or Object form, provided that You meet the following conditions: (a) You must give any other recipients of the Work or Derivative Works a copy of this License; and (b) You must cause any modified files to carry prominent notices stating that You changed the files; and (c) You must retain, in the Source form of any Derivative Works that You distribute, all copyright, patent, trademark, and attribution notices from the Source form of the Work, excluding those notices that do not pertain to any part of the Derivative Works; and (d) If the Work includes a "NOTICE" text file as part of its distribution, then any Derivative Works that You distribute must include a readable copy of the attribution notices contained within such NOTICE file, excluding those notices that do not pertain to any part of the Derivative Works, in at least one of the following places: within a NOTICE text file distributed as part of the Derivative Works; within the Source form or documentation, if provided along with the Derivative Works; or, within a display generated by the Derivative Works, if and wherever such third-party notices normally appear. The contents of the NOTICE file are for informational purposes only and do not modify the License. You may add Your own attribution notices within Derivative Works that You distribute, alongside or as an addendum to the NOTICE text from the Work, provided that such additional attribution notices cannot be construed as modifying the License. You may add Your own copyright statement to Your modifications and may provide additional or different license terms and conditions for use, reproduction, or distribution of Your modifications, or for any such Derivative Works as a whole, provided Your use, reproduction, and distribution of the Work otherwise complies with the conditions stated in this License. 5. Submission of Contributions. Unless You explicitly state otherwise, any Contribution intentionally submitted for inclusion in the Work by You to the Licensor shall be under the terms and conditions of this License, without any additional terms or conditions. Notwithstanding the above, nothing herein shall supersede or modify the terms of any separate license agreement you may have executed with Licensor regarding such Contributions. 6. Trademarks. This License does not grant permission to use the trade names, trademarks, service marks, or product names of the Licensor, except as required for reasonable and customary use in describing the origin of the Work and reproducing the content of the NOTICE file. 7. Disclaimer of Warranty. Unless required by applicable law or agreed to in writing, Licensor provides the Work (and each Contributor provides its Contributions) on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied, including, without limitation, any warranties or conditions of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A PARTICULAR PURPOSE. You are solely responsible for determining the appropriateness of using or redistributing the Work and assume any risks associated with Your exercise of permissions under this License. 8. Limitation of Liability. In no event and under no legal theory, whether in tort (including negligence), contract, or otherwise, unless required by applicable law (such as deliberate and grossly negligent acts) or agreed to in writing, shall any Contributor be liable to You for damages, including any direct, indirect, special, incidental, or consequential damages of any character arising as a result of this License or out of the use or inability to use the Work (including but not limited to damages for loss of goodwill, work stoppage, computer failure or malfunction, or any and all other commercial damages or losses), even if such Contributor has been advised of the possibility of such damages. 9. Accepting Warranty or Additional Liability. While redistributing the Work or Derivative Works thereof, You may choose to offer, and charge a fee for, acceptance of support, warranty, indemnity, or other liability obligations and/or rights consistent with this License. However, in accepting such obligations, You may act only on Your own behalf and on Your sole responsibility, not on behalf of any other Contributor, and only if You agree to indemnify, defend, and hold each Contributor harmless for any liability incurred by, or claims asserted against, such Contributor by reason of your accepting any such warranty or additional liability. END OF TERMS AND CONDITIONS APPENDIX: How to apply the Apache License to your work. To apply the Apache License to your work, attach the following boilerplate notice, with the fields enclosed by brackets "[]" replaced with your own identifying information. (Don't include the brackets!) The text should be enclosed in the appropriate comment syntax for the file format. We also recommend that a file or class name and description of purpose be included on the same "printed page" as the copyright notice for easier identification within third-party archives. Copyright [yyyy] [name of copyright owner] Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0 Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License. Authen-SCRAM-0.011/cpanfile000644 000765 000024 00000003367 13313601310 015540 0ustar00davidstaff000000 000000 requires "Authen::SASL::SASLprep" => "1.100"; requires "Carp" => "0"; requires "Crypt::URandom" => "0"; requires "Encode" => "0"; requires "MIME::Base64" => "0"; requires "Moo" => "1.001000"; requires "Moo::Role" => "1.001000"; requires "PBKDF2::Tiny" => "0.003"; requires "Try::Tiny" => "0"; requires "Types::Standard" => "0"; requires "namespace::clean" => "0"; requires "perl" => "5.008001"; requires "strict" => "0"; requires "warnings" => "0"; on 'test' => sub { requires "Exporter" => "0"; requires "ExtUtils::MakeMaker" => "0"; requires "File::Spec" => "0"; requires "Test::FailWarnings" => "0"; requires "Test::Fatal" => "0"; requires "Test::More" => "0.96"; requires "base" => "0"; requires "lib" => "0"; requires "perl" => "5.008001"; }; on 'test' => sub { recommends "CPAN::Meta" => "2.120900"; }; on 'configure' => sub { requires "ExtUtils::MakeMaker" => "6.17"; requires "perl" => "5.008"; }; on 'develop' => sub { requires "Dist::Zilla" => "5"; requires "Dist::Zilla::Plugin::RemovePrereqs" => "0"; requires "Dist::Zilla::Plugin::SurgicalPodWeaver" => "0.0021"; requires "Dist::Zilla::PluginBundle::DAGOLDEN" => "0.061"; requires "File::Spec" => "0"; requires "File::Temp" => "0"; requires "IO::Handle" => "0"; requires "IPC::Open3" => "0"; requires "Pod::Coverage::TrustPod" => "0"; requires "Pod::Wordlist" => "0"; requires "Software::License::Apache_2_0" => "0"; requires "Test::CPAN::Meta" => "0"; requires "Test::MinimumVersion" => "0"; requires "Test::More" => "0"; requires "Test::Perl::Critic" => "0"; requires "Test::Pod" => "1.41"; requires "Test::Pod::Coverage" => "1.08"; requires "Test::Portability::Files" => "0"; requires "Test::Spelling" => "0.12"; requires "Test::Version" => "1"; }; Authen-SCRAM-0.011/Changes000644 000765 000024 00000005063 13313601310 015322 0ustar00davidstaff000000 000000 Revision history for Authen-SCRAM 0.011 2018-06-23 22:32:32-04:00 America/New_York [Fixed] - Fixed circular reference in nonce generator closure 0.010 2018-06-13 09:47:13-04:00 America/New_York [Changed] - Removed String::Compare::ConstantTime as a dependency. This is a temporary measure until warnings on older Perls are addressed and released. 0.009 2018-03-26 15:33:59-04:00 America/New_York [Fixed] - Fixed tests for older Perls 0.008 2018-03-26 14:43:49-04:00 America/New_York [Fixed] - Correctly handles wide characters in usernames without mojibaking the auth signature. Previously undetected in roundtrip tests as the error was symmetric between client and server. Cross-checked via a test conversation generated from http://github.com/xdg/scram. 0.007 2018-01-28 00:00:56-05:00 America/New_York [Added] - Public 'computed_keys' method on the client object to get stored/server keys that a server needs to keep to authenticate a user. [Changed] - Added 'minimum_iteration_count' on clients, defaulting to 4096, to mitigate downgrade attacks. [Tests] - Added a SCRAM-SHA-256 test. 0.006 2017-11-22 10:45:58-05:00 America/New_York [Added] - Expensive digested password computation is cached in clients and reused for future authentication where salt and iteration count is the same. [Fixed] - Applies "stored strings" normalization when doing SASLprep, as required by https://tools.ietf.org/html/rfc5802#section-2.2 0.005 2014-10-15 17:30:07-04:00 America/New_York [Fixed] - Prevent test failures due to warnings in other modules (which we can't control) 0.004 2014-10-14 11:45:09-04:00 America/New_York [Fixed] - Fixed warnings from length() on Perls before 5.12 [Prereqs] - Bumped Moo prereq to 1.001000 for non-ref default value support 0.003 2014-10-07 22:05:31-04:00 America/New_York [Added] - Added 'skip_saslprep' attribute, in case applications insist on deviating from RFC 5802 in this regard 0.002 2014-10-06 12:09:01-04:00 America/New_York [Fixed] - Fixed handling of character encodings for non-ASCII characters in usernames and passwords [Documented] - Clarified that all inputs/outputs are expected to be character strings and that users are responsible for UTF-8 encoding/decoding during transmission and reception 0.001 2014-10-04 13:25:37-04:00 America/New_York - First release Authen-SCRAM-0.011/MANIFEST000644 000765 000024 00000001223 13313601310 015152 0ustar00davidstaff000000 000000 # This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.012. CONTRIBUTING.mkdn Changes LICENSE MANIFEST META.json META.yml Makefile.PL README cpanfile devel/scram-examples.pl dist.ini lib/Authen/SCRAM.pm lib/Authen/SCRAM/Client.pm lib/Authen/SCRAM/Role/Common.pm lib/Authen/SCRAM/Server.pm perlcritic.rc t/00-report-prereqs.dd t/00-report-prereqs.t t/client.t t/errors.t t/lib/TestSCRAM.pm t/round_trip.t t/server.t tidyall.ini xt/author/00-compile.t xt/author/critic.t xt/author/minimum-version.t xt/author/pod-coverage.t xt/author/pod-spell.t xt/author/pod-syntax.t xt/author/portability.t xt/author/test-version.t xt/release/distmeta.t Authen-SCRAM-0.011/perlcritic.rc000644 000765 000024 00000001166 13313601310 016515 0ustar00davidstaff000000 000000 severity = 5 verbose = 8 [Variables::ProhibitPunctuationVars] allow = $@ $! [TestingAndDebugging::ProhibitNoStrict] allow = refs [Variables::ProhibitEvilVariables] variables = $DB::single # Turn these off [-BuiltinFunctions::ProhibitStringyEval] [-ControlStructures::ProhibitPostfixControls] [-ControlStructures::ProhibitUnlessBlocks] [-Documentation::RequirePodSections] [-InputOutput::ProhibitInteractiveTest] [-References::ProhibitDoubleSigils] [-RegularExpressions::RequireExtendedFormatting] [-InputOutput::ProhibitTwoArgOpen] [-Modules::ProhibitEvilModules] # Turn this on [Lax::ProhibitStringyEval::ExceptForRequire] Authen-SCRAM-0.011/CONTRIBUTING.mkdn000644 000765 000024 00000006512 13313601310 016611 0ustar00davidstaff000000 000000 ## HOW TO CONTRIBUTE Thank you for considering contributing to this distribution. This file contains instructions that will help you work with the source code. The distribution is managed with Dist::Zilla. This means than many of the usual files you might expect are not in the repository, but are generated at release time (e.g. Makefile.PL). Generally, **you do not need Dist::Zilla to contribute patches**. You do need Dist::Zilla to create a tarball and/or install from the repository. See below for guidance. ### Getting dependencies See the included `cpanfile` file for a list of dependencies. If you have App::cpanminus 1.6 or later installed, you can use `cpanm` to satisfy dependencies like this: $ cpanm --installdeps . Otherwise, you can install Module::CPANfile 1.0002 or later and then satisfy dependencies with the regular `cpan` client and `cpanfile-dump`: $ cpan `cpanfile-dump` ### Running tests You can run tests directly using the `prove` tool: $ prove -l $ prove -lv t/some_test_file.t For most of my distributions, `prove` is entirely sufficient for you to test any patches you have. I use `prove` for 99% of my testing during development. ### Code style and tidying Please try to match any existing coding style. If there is a `.perltidyrc` file, please install Perl::Tidy and use perltidy before submitting patches. If there is a `tidyall.ini` file, you can also install Code::TidyAll and run `tidyall` on a file or `tidyall -a` to tidy all files. ### Patching documentation Much of the documentation Pod is generated at release time. Depending on the distribution, some of my documentation may be written in a Pod dialect called WikiDoc. (See Pod::WikiDoc on CPAN.) If you would like to submit a documentation edit, please limit yourself to the documentation you see. If you see typos or documentation issues in the generated docs, please email or open a bug ticket instead of patching. ### Installing from the repository If you want to install directly from the repository, you need to have Dist::Zilla installed (see below). If this is a burden to you, I welcome patches against a CPAN tarball instead of the repository. ### Installing and using Dist::Zilla Dist::Zilla is a very powerful authoring tool, optimized for maintaining a large number of distributions with a high degree of automation, but it has a large dependency chain, a bit of a learning curve and requires a number of author-specific plugins. To install it from CPAN, I recommend one of the following approaches for the quickest installation: # using CPAN.pm, but bypassing non-functional pod tests $ cpan TAP::Harness::Restricted $ PERL_MM_USE_DEFAULT=1 HARNESS_CLASS=TAP::Harness::Restricted cpan Dist::Zilla # using cpanm, bypassing *all* tests $ cpanm -n Dist::Zilla In either case, it's probably going to take about 10 minutes. Go for a walk, go get a cup of your favorite beverage, take a bathroom break, or whatever. When you get back, Dist::Zilla should be ready for you. Then you need to install any plugins specific to this distribution: $ cpan `dzil authordeps` $ dzil authordeps | cpanm Once installed, here are some dzil commands you might try: $ dzil build $ dzil test $ dzil xtest To install from the repository, use: $ dzil install You can learn more about Dist::Zilla at http://dzil.org/ Authen-SCRAM-0.011/t/000755 000765 000024 00000000000 13313601310 014266 5ustar00davidstaff000000 000000 Authen-SCRAM-0.011/xt/000755 000765 000024 00000000000 13313601310 014456 5ustar00davidstaff000000 000000 Authen-SCRAM-0.011/README000644 000765 000024 00000006171 13313601310 014710 0ustar00davidstaff000000 000000 NAME Authen::SCRAM - Salted Challenge Response Authentication Mechanism (RFC 5802) VERSION version 0.011 SYNOPSIS use Authen::SCRAM::Client; use Authen::SCRAM::Server; use Try::Tiny; ### CLIENT SIDE ### $client = Authen::SCRAM::Client->new( username => 'johndoe', password => 'trustno1', ); try { $client_first = $client->first_msg(); # send to server and get server-first-message $client_final = $client->final_msg( $server_first ); # send to server and get server-final-message $client->validate( $server_final ); } catch { die "Authentication failed!" }; ### SERVER SIDE ### $server = Authen::SCRAM::Server->new( credential_cb => \&get_credentials, ); $username = try { # get client-first-message $server_first = $server->first_msg( $client_first ); # send to client and get client-final-message $server_final = $server->final_msg( $client_final ); # send to client return $server->authorization_id; # returns valid username } catch { die "Authentication failed!" }; DESCRIPTION The modules in this distribution implement the Salted Challenge Response Authentication Mechanism (SCRAM) from RFC 5802. See Authen::SCRAM::Client and Authen::SCRAM::Server for usage details. NAME Authen::SCRAM - Salted Challenge Response Authentication Mechanism (RFC 5802) VERSION version 0.011 SUPPORT Bugs / Feature Requests Please report any bugs or feature requests through the issue tracker at . You will be notified automatically of any progress on your issue. Source Code This is open source software. The code repository is available for public review and contribution under the terms of the license. git clone https://github.com/dagolden/Authen-SCRAM.git AUTHOR David Golden CONTRIBUTOR David Golden COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by David Golden. This is free software, licensed under: The Apache License, Version 2.0, January 2004 SUPPORT Bugs / Feature Requests Please report any bugs or feature requests through the issue tracker at . You will be notified automatically of any progress on your issue. Source Code This is open source software. The code repository is available for public review and contribution under the terms of the license. git clone https://github.com/dagolden/Authen-SCRAM.git AUTHOR David Golden CONTRIBUTOR David Golden COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by David Golden. This is free software, licensed under: The Apache License, Version 2.0, January 2004 Authen-SCRAM-0.011/META.yml000644 000765 000024 00000003214 13313601310 015274 0ustar00davidstaff000000 000000 --- abstract: 'Salted Challenge Response Authentication Mechanism (RFC 5802)' author: - 'David Golden ' build_requires: Exporter: '0' ExtUtils::MakeMaker: '0' File::Spec: '0' Test::FailWarnings: '0' Test::Fatal: '0' Test::More: '0.96' base: '0' lib: '0' perl: '5.008001' configure_requires: ExtUtils::MakeMaker: '6.17' perl: '5.008' dynamic_config: 0 generated_by: 'Dist::Zilla version 6.012, CPAN::Meta::Converter version 2.150010' license: apache meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Authen-SCRAM no_index: directory: - corpus - examples - t - xt package: - DB provides: Authen::SCRAM: file: lib/Authen/SCRAM.pm version: '0.011' Authen::SCRAM::Client: file: lib/Authen/SCRAM/Client.pm version: '0.011' Authen::SCRAM::Role::Common: file: lib/Authen/SCRAM/Role/Common.pm version: '0.011' Authen::SCRAM::Server: file: lib/Authen/SCRAM/Server.pm version: '0.011' requires: Authen::SASL::SASLprep: '1.100' Carp: '0' Crypt::URandom: '0' Encode: '0' MIME::Base64: '0' Moo: '1.001000' Moo::Role: '1.001000' PBKDF2::Tiny: '0.003' Try::Tiny: '0' Types::Standard: '0' namespace::clean: '0' perl: '5.008001' strict: '0' warnings: '0' resources: bugtracker: https://github.com/dagolden/Authen-SCRAM/issues homepage: https://github.com/dagolden/Authen-SCRAM repository: https://github.com/dagolden/Authen-SCRAM.git version: '0.011' x_authority: cpan:DAGOLDEN x_contributors: - 'David Golden ' x_generated_by_perl: v5.26.1 x_serialization_backend: 'YAML::Tiny version 1.70' Authen-SCRAM-0.011/tidyall.ini000644 000765 000024 00000000240 13313601310 016162 0ustar00davidstaff000000 000000 ; Install Code::TidyAll ; run "tidyall -a" to tidy all files ; run "tidyall -g" to tidy only files modified from git [PerlTidy] select = {lib,t}/**/*.{pl,pm,t} Authen-SCRAM-0.011/lib/000755 000765 000024 00000000000 13313601310 014571 5ustar00davidstaff000000 000000 Authen-SCRAM-0.011/Makefile.PL000644 000765 000024 00000003725 13313601310 016004 0ustar00davidstaff000000 000000 # This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v6.012. use strict; use warnings; use 5.008001; use ExtUtils::MakeMaker 6.17; my %WriteMakefileArgs = ( "ABSTRACT" => "Salted Challenge Response Authentication Mechanism (RFC 5802)", "AUTHOR" => "David Golden ", "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => "6.17" }, "DISTNAME" => "Authen-SCRAM", "LICENSE" => "apache", "MIN_PERL_VERSION" => "5.008001", "NAME" => "Authen::SCRAM", "PREREQ_PM" => { "Authen::SASL::SASLprep" => "1.100", "Carp" => 0, "Crypt::URandom" => 0, "Encode" => 0, "MIME::Base64" => 0, "Moo" => "1.001000", "Moo::Role" => "1.001000", "PBKDF2::Tiny" => "0.003", "Try::Tiny" => 0, "Types::Standard" => 0, "namespace::clean" => 0, "strict" => 0, "warnings" => 0 }, "TEST_REQUIRES" => { "Exporter" => 0, "ExtUtils::MakeMaker" => 0, "File::Spec" => 0, "Test::FailWarnings" => 0, "Test::Fatal" => 0, "Test::More" => "0.96", "base" => 0, "lib" => 0 }, "VERSION" => "0.011", "test" => { "TESTS" => "t/*.t" } ); my %FallbackPrereqs = ( "Authen::SASL::SASLprep" => "1.100", "Carp" => 0, "Crypt::URandom" => 0, "Encode" => 0, "Exporter" => 0, "ExtUtils::MakeMaker" => 0, "File::Spec" => 0, "MIME::Base64" => 0, "Moo" => "1.001000", "Moo::Role" => "1.001000", "PBKDF2::Tiny" => "0.003", "Test::FailWarnings" => 0, "Test::Fatal" => 0, "Test::More" => "0.96", "Try::Tiny" => 0, "Types::Standard" => 0, "base" => 0, "lib" => 0, "namespace::clean" => 0, "strict" => 0, "warnings" => 0 ); unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) { delete $WriteMakefileArgs{TEST_REQUIRES}; delete $WriteMakefileArgs{BUILD_REQUIRES}; $WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs; } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; WriteMakefile(%WriteMakefileArgs); Authen-SCRAM-0.011/META.json000644 000765 000024 00000007251 13313601310 015451 0ustar00davidstaff000000 000000 { "abstract" : "Salted Challenge Response Authentication Mechanism (RFC 5802)", "author" : [ "David Golden " ], "dynamic_config" : 0, "generated_by" : "Dist::Zilla version 6.012, CPAN::Meta::Converter version 2.150010", "license" : [ "apache_2_0" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Authen-SCRAM", "no_index" : { "directory" : [ "corpus", "examples", "t", "xt" ], "package" : [ "DB" ] }, "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "6.17", "perl" : "5.008" } }, "develop" : { "requires" : { "Dist::Zilla" : "5", "Dist::Zilla::Plugin::RemovePrereqs" : "0", "Dist::Zilla::Plugin::SurgicalPodWeaver" : "0.0021", "Dist::Zilla::PluginBundle::DAGOLDEN" : "0.061", "File::Spec" : "0", "File::Temp" : "0", "IO::Handle" : "0", "IPC::Open3" : "0", "Pod::Coverage::TrustPod" : "0", "Pod::Wordlist" : "0", "Software::License::Apache_2_0" : "0", "Test::CPAN::Meta" : "0", "Test::MinimumVersion" : "0", "Test::More" : "0", "Test::Perl::Critic" : "0", "Test::Pod" : "1.41", "Test::Pod::Coverage" : "1.08", "Test::Portability::Files" : "0", "Test::Spelling" : "0.12", "Test::Version" : "1" } }, "runtime" : { "requires" : { "Authen::SASL::SASLprep" : "1.100", "Carp" : "0", "Crypt::URandom" : "0", "Encode" : "0", "MIME::Base64" : "0", "Moo" : "1.001000", "Moo::Role" : "1.001000", "PBKDF2::Tiny" : "0.003", "Try::Tiny" : "0", "Types::Standard" : "0", "namespace::clean" : "0", "perl" : "5.008001", "strict" : "0", "warnings" : "0" } }, "test" : { "recommends" : { "CPAN::Meta" : "2.120900" }, "requires" : { "Exporter" : "0", "ExtUtils::MakeMaker" : "0", "File::Spec" : "0", "Test::FailWarnings" : "0", "Test::Fatal" : "0", "Test::More" : "0.96", "base" : "0", "lib" : "0", "perl" : "5.008001" } } }, "provides" : { "Authen::SCRAM" : { "file" : "lib/Authen/SCRAM.pm", "version" : "0.011" }, "Authen::SCRAM::Client" : { "file" : "lib/Authen/SCRAM/Client.pm", "version" : "0.011" }, "Authen::SCRAM::Role::Common" : { "file" : "lib/Authen/SCRAM/Role/Common.pm", "version" : "0.011" }, "Authen::SCRAM::Server" : { "file" : "lib/Authen/SCRAM/Server.pm", "version" : "0.011" } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/dagolden/Authen-SCRAM/issues" }, "homepage" : "https://github.com/dagolden/Authen-SCRAM", "repository" : { "type" : "git", "url" : "https://github.com/dagolden/Authen-SCRAM.git", "web" : "https://github.com/dagolden/Authen-SCRAM" } }, "version" : "0.011", "x_authority" : "cpan:DAGOLDEN", "x_contributors" : [ "David Golden " ], "x_generated_by_perl" : "v5.26.1", "x_serialization_backend" : "Cpanel::JSON::XS version 3.0239" } Authen-SCRAM-0.011/dist.ini000644 000765 000024 00000000631 13313601310 015467 0ustar00davidstaff000000 000000 name = Authen-SCRAM author = David Golden license = Apache_2_0 copyright_holder = David Golden copyright_year = 2014 [@DAGOLDEN] :version = 0.061 -remove = PodWeaver stopwords = SASLprep [SurgicalPodWeaver] :version = 0.0021 config_plugin = @DAGOLDEN replacer = replace_with_comment post_code_replacer = replace_with_nothing [RemovePrereqs] remove = String::Compare::ConstantTime Authen-SCRAM-0.011/lib/Authen/000755 000765 000024 00000000000 13313601310 016015 5ustar00davidstaff000000 000000 Authen-SCRAM-0.011/lib/Authen/SCRAM/000755 000765 000024 00000000000 13313601310 016662 5ustar00davidstaff000000 000000 Authen-SCRAM-0.011/lib/Authen/SCRAM.pm000644 000765 000024 00000007100 13313601310 017216 0ustar00davidstaff000000 000000 use 5.008; use strict; use warnings; package Authen::SCRAM; # ABSTRACT: Salted Challenge Response Authentication Mechanism (RFC 5802) our $VERSION = '0.011'; 1; # vim: ts=4 sts=4 sw=4 et: __END__ =pod =encoding UTF-8 =head1 NAME Authen::SCRAM - Salted Challenge Response Authentication Mechanism (RFC 5802) =head1 VERSION version 0.011 =head1 SYNOPSIS use Authen::SCRAM::Client; use Authen::SCRAM::Server; use Try::Tiny; ### CLIENT SIDE ### $client = Authen::SCRAM::Client->new( username => 'johndoe', password => 'trustno1', ); try { $client_first = $client->first_msg(); # send to server and get server-first-message $client_final = $client->final_msg( $server_first ); # send to server and get server-final-message $client->validate( $server_final ); } catch { die "Authentication failed!" }; ### SERVER SIDE ### $server = Authen::SCRAM::Server->new( credential_cb => \&get_credentials, ); $username = try { # get client-first-message $server_first = $server->first_msg( $client_first ); # send to client and get client-final-message $server_final = $server->final_msg( $client_final ); # send to client return $server->authorization_id; # returns valid username } catch { die "Authentication failed!" }; =head1 DESCRIPTION The modules in this distribution implement the Salted Challenge Response Authentication Mechanism (SCRAM) from RFC 5802. See L and L for usage details. =head1 NAME Authen::SCRAM - Salted Challenge Response Authentication Mechanism (RFC 5802) =head1 VERSION version 0.011 =for Pod::Coverage BUILD =for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan =head1 SUPPORT =head2 Bugs / Feature Requests Please report any bugs or feature requests through the issue tracker at L. You will be notified automatically of any progress on your issue. =head2 Source Code This is open source software. The code repository is available for public review and contribution under the terms of the license. L git clone https://github.com/dagolden/Authen-SCRAM.git =head1 AUTHOR David Golden =head1 CONTRIBUTOR =for stopwords David Golden David Golden =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by David Golden. This is free software, licensed under: The Apache License, Version 2.0, January 2004 =for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan =head1 SUPPORT =head2 Bugs / Feature Requests Please report any bugs or feature requests through the issue tracker at L. You will be notified automatically of any progress on your issue. =head2 Source Code This is open source software. The code repository is available for public review and contribution under the terms of the license. L git clone https://github.com/dagolden/Authen-SCRAM.git =head1 AUTHOR David Golden =head1 CONTRIBUTOR =for stopwords David Golden David Golden =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by David Golden. This is free software, licensed under: The Apache License, Version 2.0, January 2004 =cut Authen-SCRAM-0.011/lib/Authen/SCRAM/Server.pm000644 000765 000024 00000031461 13313601310 020473 0ustar00davidstaff000000 000000 use 5.008; use strict; use warnings; package Authen::SCRAM::Server; # ABSTRACT: RFC 5802 SCRAM Server our $VERSION = '0.011'; use Moo 1.001000; use Authen::SASL::SASLprep qw/saslprep/; use Carp qw/croak/; use Crypt::URandom qw/urandom/; use Encode qw/encode_utf8/; use MIME::Base64 qw/decode_base64/; use PBKDF2::Tiny 0.003 qw/derive digest_fcn hmac/; use Types::Standard qw/Str Num CodeRef Bool/; use namespace::clean; with 'Authen::SCRAM::Role::Common'; #--------------------------------------------------------------------------# # public attributes #--------------------------------------------------------------------------# #pod =attr credential_cb (required) #pod #pod This attribute must contain a code reference that takes a username (as a #pod character string normalized by SASLprep) and returns the four user-credential #pod parameters required by SCRAM: C, C, C, and #pod C. The C, C and C must be #pod provided as octets (i.e. B base64 encoded). #pod #pod If the username is unknown, it should return an empty list. #pod #pod ($salt, $stored_key, $server_key, $iterations) = #pod $server->credential_cb->( $username ); #pod #pod See L #pod for details. #pod #pod =cut has credential_cb => ( is => 'ro', isa => CodeRef, required => 1, ); #pod =attr auth_proxy_cb #pod #pod If provided, this attribute must contain a code reference that takes an #pod B username and a B username (both as character #pod strings), and return a true value if the authentication username is permitted #pod to act as the authorization username: #pod #pod $bool = $server->auth_proxy_cb->( #pod $authentication_user, $authorization_user #pod ); #pod #pod It will only be all called if the authentication username has successfully #pod authenticated. Both usernames will have been normalized via C with #pod any transport encoding removed before being passed to this function. #pod #pod =cut has auth_proxy_cb => ( is => 'ro', isa => CodeRef, default => sub { return sub { 1 } }, ); #--------------------------------------------------------------------------# # provided by Authen::SCRAM::Role::Common #--------------------------------------------------------------------------# with 'Authen::SCRAM::Role::Common'; #pod =attr digest #pod #pod Name of a digest function available via L. Valid values are #pod SHA-1, SHA-224, SHA-256, SHA-384, or SHA-512. Defaults to SHA-1. #pod #pod =attr nonce_size #pod #pod Size of the client-generated nonce, in bits. Defaults to 192. #pod The server-nonce will be appended, so the final nonce size will #pod be substantially larger. #pod #pod =attr skip_saslprep #pod #pod A boolean that defaults to false. If set to true, usernames and passwords will #pod not be normalized through SASLprep. This is a deviation from the RFC5802 spec #pod and is not recommended. #pod #pod =cut #--------------------------------------------------------------------------# # private attributes #--------------------------------------------------------------------------# has _proof_ok => ( is => 'ro', isa => Bool, writer => '_set_proof_ok', ); #--------------------------------------------------------------------------# # public methods #--------------------------------------------------------------------------# #pod =method first_msg #pod #pod $server_first_msg = $server->first_msg( $client_first_msg ); #pod #pod This takes the C received from the client and returns the #pod C string to be sent to the client to continue a SCRAM #pod session. Calling this again will reset the internal state and initiate a new #pod session. This will throw an exception should an error occur. #pod #pod =cut sub first_msg { my ( $self, $msg ) = @_; $self->_clear_session; my ( $cbind, $authz, $c_1_bare, $mext, @params ) = $msg =~ $self->_client_first_re; if ( !defined $cbind ) { croak "SCRAM client-first-message could not be parsed"; } if ( $cbind eq 'p' ) { croak "SCRAM client-first-message required channel binding, but we do not support it"; } if ( defined $mext ) { croak "SCRAM client-first-message required mandatory extension '$mext', but we do not support it"; } push @params, $authz if defined $authz; $self->_parse_to_session(@params); $self->_extend_nonce; my $name = $self->_get_session('n'); my ( $salt, $stored_key, $server_key, $iters ) = $self->credential_cb->($name); if ( !defined $salt ) { croak "SCRAM client-first-message had unknown user '$name'"; } $self->_set_session( s => $self->_base64($salt), i => $iters, _c1b => $c_1_bare, _stored_key => $stored_key, _server_key => $server_key ); my $reply = $self->_join_reply(qw/r s i/); $self->_set_session( _s1 => $reply ); return $reply; } #pod =method final_msg #pod #pod $server_final_msg = $server->final_msg( $client_final_msg ); #pod #pod This takes the C received from the client and returns the #pod C string containing the verification signature to be sent #pod to the client. #pod #pod If an authorization identity was provided by the client, it will confirm that #pod the authenticating username is authorized to act as the authorization id using #pod the L attribute. #pod #pod If the client credentials do not match or the authentication name is not #pod authorized to act as the authorization name, then an exception will be thrown. #pod #pod =cut sub final_msg { my ( $self, $msg ) = @_; my ( $c2wop, @params ) = $msg =~ $self->_client_final_re; $self->_set_session( _c2wop => $c2wop ); if ( !defined $c2wop ) { croak "SCRAM client-first-message could not be parsed"; } # confirm nonce my $original_nonce = $self->_get_session("r"); $self->_parse_to_session(@params); my $joint_nonce = $self->_get_session("r"); unless ( $joint_nonce eq $original_nonce ) { croak "SCRAM client-final-message nonce invalid"; } # confirm channel bindings my $cbind = $self->_base64( encode_utf8( $self->_construct_gs2( $self->_get_session("a") ) ) ); if ( $cbind ne $self->_get_session("c") ) { croak "SCRAM client-final-message channel binding didn't match"; } # confirm proof my $client_sig = $self->_client_sig; my $proof = decode_base64( $self->_get_session("p") ); my $client_key = $proof ^ $client_sig; my $computed_key = $self->_digest_fcn->($client_key); my $name = $self->_get_session("n"); if ( !$self->_const_eq_fcn->( $computed_key, $self->_get_session("_stored_key") ) ) { croak "SCRAM authentication for user '$name' failed"; } if ( my $authz = $self->_get_session("a") ) { $self->auth_proxy_cb->( $name, $authz ) or croak("SCRAM authentication failed; '$name' not authorized to act as '$authz'"); } $self->_set_session( _proof_ok => 1 ); my $server_sig = $self->_hmac_fcn->( $self->_get_session('_server_key'), $self->_auth_msg ); $self->_set_session( v => $self->_base64($server_sig) ); $self->_join_reply('v'); } #pod =method authorization_id #pod #pod $username = $client->authorization_id(); #pod #pod This takes no arguments and returns the authorization identity resulting from #pod the SCRAM exchange. This is the client-supplied authorization identity (if one #pod was provided and validated) or else the successfully authenticated identity. #pod #pod =cut sub authorization_id { my ($self) = @_; return '' unless $self->_get_session("_proof_ok"); my $authz = $self->_get_session("a"); return ( defined($authz) && length($authz) ) ? $authz : $self->_get_session("n"); } 1; # vim: ts=4 sts=4 sw=4 et: __END__ =pod =encoding UTF-8 =head1 NAME Authen::SCRAM::Server - RFC 5802 SCRAM Server =head1 VERSION version 0.011 =head1 SYNOPSIS use Authen::SCRAM::Server; use Try::Tiny; $server = Authen::SCRAM::Server->new( credential_cb => \&get_credentials, ); $username = try { # get client-first-message $server_first = $server->first_msg( $client_first ); # send to client and get client-final-message $server_final = $server->final_msg( $client_final ); # send to client return $server->authorization_id; # returns valid username } catch { die "Authentication failed!" }; =head1 DESCRIPTION This module implements the server-side SCRAM algorithm. =head1 NAME Authen::SCRAM::Server - RFC 5802 SCRAM Server =head1 VERSION version 0.011 =head1 ATTRIBUTES =head2 credential_cb (required) This attribute must contain a code reference that takes a username (as a character string normalized by SASLprep) and returns the four user-credential parameters required by SCRAM: C, C, C, and C. The C, C and C must be provided as octets (i.e. B base64 encoded). If the username is unknown, it should return an empty list. ($salt, $stored_key, $server_key, $iterations) = $server->credential_cb->( $username ); See L for details. =head2 auth_proxy_cb If provided, this attribute must contain a code reference that takes an B username and a B username (both as character strings), and return a true value if the authentication username is permitted to act as the authorization username: $bool = $server->auth_proxy_cb->( $authentication_user, $authorization_user ); It will only be all called if the authentication username has successfully authenticated. Both usernames will have been normalized via C with any transport encoding removed before being passed to this function. =head2 digest Name of a digest function available via L. Valid values are SHA-1, SHA-224, SHA-256, SHA-384, or SHA-512. Defaults to SHA-1. =head2 nonce_size Size of the client-generated nonce, in bits. Defaults to 192. The server-nonce will be appended, so the final nonce size will be substantially larger. =head2 skip_saslprep A boolean that defaults to false. If set to true, usernames and passwords will not be normalized through SASLprep. This is a deviation from the RFC5802 spec and is not recommended. =head1 METHODS =head2 first_msg $server_first_msg = $server->first_msg( $client_first_msg ); This takes the C received from the client and returns the C string to be sent to the client to continue a SCRAM session. Calling this again will reset the internal state and initiate a new session. This will throw an exception should an error occur. =head2 final_msg $server_final_msg = $server->final_msg( $client_final_msg ); This takes the C received from the client and returns the C string containing the verification signature to be sent to the client. If an authorization identity was provided by the client, it will confirm that the authenticating username is authorized to act as the authorization id using the L attribute. If the client credentials do not match or the authentication name is not authorized to act as the authorization name, then an exception will be thrown. =head2 authorization_id $username = $client->authorization_id(); This takes no arguments and returns the authorization identity resulting from the SCRAM exchange. This is the client-supplied authorization identity (if one was provided and validated) or else the successfully authenticated identity. =for Pod::Coverage BUILD =head1 CHARACTER ENCODING CAVEAT The SCRAM protocol mandates UTF-8 interchange. However, all methods in this module take and return B strings. You must encode to UTF-8 before sending and decode from UTF-8 on receiving according to whatever transport mechanism you are using. This is done to avoid double encoding/decoding problems if your transport is already doing UTF-8 encoding or decoding as it constructs outgoing messages or parses incoming messages. =head1 AUTHOR David Golden =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by David Golden. This is free software, licensed under: The Apache License, Version 2.0, January 2004 =head1 AUTHOR David Golden =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by David Golden. This is free software, licensed under: The Apache License, Version 2.0, January 2004 =cut Authen-SCRAM-0.011/lib/Authen/SCRAM/Role/000755 000765 000024 00000000000 13313601310 017563 5ustar00davidstaff000000 000000 Authen-SCRAM-0.011/lib/Authen/SCRAM/Client.pm000644 000765 000024 00000032037 13313601310 020443 0ustar00davidstaff000000 000000 use 5.008; use strict; use warnings; package Authen::SCRAM::Client; # ABSTRACT: RFC 5802 SCRAM client our $VERSION = '0.011'; use Moo 1.001000; use Carp qw/croak/; use Encode qw/encode_utf8/; use MIME::Base64 qw/decode_base64/; use PBKDF2::Tiny 0.003 qw/derive/; use Try::Tiny; use Types::Standard qw/Str Num/; use namespace::clean; #--------------------------------------------------------------------------# # public attributes #--------------------------------------------------------------------------# #pod =attr username (required) #pod #pod Authentication identity. This will be normalized with the SASLprep algorithm #pod before being transmitted to the server. #pod #pod =cut has username => ( is => 'ro', isa => Str, required => 1, ); #pod =attr password (required) #pod #pod Authentication password. This will be normalized with the SASLprep algorithm #pod before being transmitted to the server. #pod #pod =cut has password => ( is => 'ro', isa => Str, required => 1, ); #pod =attr authorization_id #pod #pod If the authentication identity (C) will act as a different, #pod authorization identity, this attribute provides the authorization identity. It #pod is optional. If not provided, the authentication identity is considered by the #pod server to be the same as the authorization identity. #pod #pod =cut has authorization_id => ( is => 'ro', isa => Str, default => '', ); #pod =attr minimum_iteration_count #pod #pod If the server requests an iteration count less than this value, the client #pod throws an error. This protects against downgrade attacks. The default is #pod 4096, consistent with recommendations in the RFC. #pod #pod =cut has minimum_iteration_count => ( is => 'ro', isa => Num, default => 4096, ); # The derived PBKDF2 password can be reused if the salt and iteration count # is the same as a previous authentication conversation. has _cached_credentials => ( is => 'rw', default => sub { [ "", 0, "" ] }, # salt, iterations, derived password ); #--------------------------------------------------------------------------# # provided by Authen::SCRAM::Role::Common #--------------------------------------------------------------------------# with 'Authen::SCRAM::Role::Common'; #pod =attr digest #pod #pod Name of a digest function available via L. Valid values are #pod SHA-1, SHA-224, SHA-256, SHA-384, or SHA-512. Defaults to SHA-1. #pod #pod =attr nonce_size #pod #pod Size of the client-generated nonce, in bits. Defaults to 192. #pod The server-nonce will be appended, so the final nonce size will #pod be substantially larger. #pod #pod =attr skip_saslprep #pod #pod A boolean that defaults to false. If set to true, usernames and passwords will #pod not be normalized through SASLprep. This is a deviation from the RFC5802 spec #pod and is not recommended. #pod #pod =cut #--------------------------------------------------------------------------# # private attributes #--------------------------------------------------------------------------# has _prepped_user => ( is => 'lazy', isa => Str, ); sub _build__prepped_user { my ($self) = @_; return $self->_saslprep( $self->username ); } has _prepped_pass => ( is => 'lazy', isa => Str, ); sub _build__prepped_pass { my ($self) = @_; return $self->_saslprep( $self->password ); } has _prepped_authz => ( is => 'lazy', isa => Str, ); sub _build__prepped_authz { my ($self) = @_; return $self->_saslprep( $self->authorization_id ); } has _gs2_header => ( is => 'lazy', isa => Str, ); sub _build__gs2_header { my ($self) = @_; return $self->_construct_gs2( $self->_prepped_authz ); } #--------------------------------------------------------------------------# # public methods #--------------------------------------------------------------------------# #pod =method first_msg #pod #pod $client_first_msg = $client->first_msg(); #pod #pod This takes no arguments and returns the C character #pod string to be sent to the server to initiate a SCRAM session. Calling this #pod again will reset the internal state and initiate a new session. This will #pod throw an exception should an error occur. #pod #pod =cut sub first_msg { my ($self) = @_; $self->_clear_session; $self->_set_session( n => $self->_prepped_user, r => $self->_get_session('_nonce'), ); my $c_1_bare = $self->_join_reply(qw/n r/); $self->_set_session( _c1b => $c_1_bare ); my $msg = $self->_gs2_header . $c_1_bare; utf8::upgrade($msg); # ensure UTF-8 encoding internally return $msg; } #pod =method final_msg #pod #pod $client_final_msg = $client->final_msg( $server_first_msg ); #pod #pod This takes the C character string received from the #pod server and returns the C character string containing the #pod authentication proof to be sent to the server. This will throw an exception #pod should an error occur. #pod #pod =cut sub final_msg { my ( $self, $s_first_msg ) = @_; my ( $mext, @params ) = $s_first_msg =~ $self->_server_first_re; if ( defined $mext ) { croak "SCRAM server-first-message required mandatory extension '$mext', but we do not support it"; } if ( !@params ) { croak "SCRAM server-first-message could not be parsed"; } my $original_nonce = $self->_get_session("r"); $self->_parse_to_session(@params); my $joint_nonce = $self->_get_session("r"); unless ( $joint_nonce =~ m{^\Q$original_nonce\E.} ) { croak "SCRAM server-first-message nonce invalid"; } # assemble client-final-wo-proof $self->_set_session( _s1 => $s_first_msg, c => $self->_base64( encode_utf8( $self->_gs2_header ) ), ); $self->_set_session( '_c2wop' => $self->_join_reply(qw/c r/) ); # assemble proof my $salt = decode_base64( $self->_get_session("s") ); my $iters = $self->_get_session("i"); if ( $iters < $self->minimum_iteration_count ) { croak sprintf( "SCRAM server requested %d iterations, less than the minimum of %d", $iters, $self->minimum_iteration_count ); } my ( $stored_key, $client_key, $server_key ) = $self->computed_keys( $salt, $iters ); $self->_set_session( _stored_key => $stored_key, _server_key => $server_key, ); my $client_sig = $self->_client_sig; $self->_set_session( p => $self->_base64( $client_key ^ $client_sig ) ); return $self->_join_reply(qw/c r p/); } #pod =method validate #pod #pod $client->validate( $server_final_msg ); #pod #pod This takes the C character string received from the #pod server and verifies that the server actually has a copy of the client #pod credentials. It will return true if valid and throw an exception, otherwise. #pod #pod =cut sub validate { my ( $self, $s_final_msg ) = @_; my (@params) = $s_final_msg =~ $self->_server_final_re; $self->_parse_to_session(@params); if ( my $err = $self->_get_session("e") ) { croak "SCRAM server-final-message was error '$err'"; } my $server_sig = $self->_hmac_fcn->( $self->_get_session("_server_key"), $self->_auth_msg ); if ( $self->_base64($server_sig) ne $self->_get_session("v") ) { croak "SCRAM server-final-message failed validation"; } return 1; } #pod =method computed_keys #pod #pod This method returns the opaque keys used in the SCRAM protocol. It returns #pod the 'stored key', the 'client key' and the 'server key'. The server must #pod have a copy of the stored key and server key for a given user in order to #pod authenticate. #pod #pod This method caches the computed values -- it generates them fresh only if #pod the supplied salt and iteration count don't match the cached salt and #pod iteration count. #pod #pod =cut sub computed_keys { my ( $self, $salt, $iters ) = @_; my $cache = $self->_cached_credentials; if ( $cache->[0] eq $salt && $cache->[1] == $iters ) { # return stored key, client key, server key return @{$cache}[ 2 .. 4 ]; } my $salted_pw = derive( $self->digest, encode_utf8( $self->_prepped_pass ), $salt, $iters ); my $client_key = $self->_hmac_fcn->( $salted_pw, "Client Key" ); my $server_key = $self->_hmac_fcn->( $salted_pw, "Server Key" ); my $stored_key = $self->_digest_fcn->($client_key); $self->_cached_credentials( [ $salt, $iters, $stored_key, $client_key, $server_key ] ); return ( $stored_key, $client_key, $server_key ); } 1; # vim: ts=4 sts=4 sw=4 et: __END__ =pod =encoding UTF-8 =head1 NAME Authen::SCRAM::Client - RFC 5802 SCRAM client =head1 VERSION version 0.011 =head1 SYNOPSIS use Authen::SCRAM::Client; use Try::Tiny; $client = Authen::SCRAM::Client->new( username => 'johndoe', password => 'trustno1', ); try { $client_first = $client->first_msg(); # send to server and get server-first-message $client_final = $client->final_msg( $server_first ); # send to server and get server-final-message $client->validate( $server_final ); } catch { die "Authentication failed!" }; =head1 DESCRIPTION This module implements the client-side SCRAM algorithm. =head1 NAME Authen::SCRAM::Client - RFC 5802 SCRAM client =head1 VERSION version 0.011 =head1 ATTRIBUTES =head2 username (required) Authentication identity. This will be normalized with the SASLprep algorithm before being transmitted to the server. =head2 password (required) Authentication password. This will be normalized with the SASLprep algorithm before being transmitted to the server. =head2 authorization_id If the authentication identity (C) will act as a different, authorization identity, this attribute provides the authorization identity. It is optional. If not provided, the authentication identity is considered by the server to be the same as the authorization identity. =head2 minimum_iteration_count If the server requests an iteration count less than this value, the client throws an error. This protects against downgrade attacks. The default is 4096, consistent with recommendations in the RFC. =head2 digest Name of a digest function available via L. Valid values are SHA-1, SHA-224, SHA-256, SHA-384, or SHA-512. Defaults to SHA-1. =head2 nonce_size Size of the client-generated nonce, in bits. Defaults to 192. The server-nonce will be appended, so the final nonce size will be substantially larger. =head2 skip_saslprep A boolean that defaults to false. If set to true, usernames and passwords will not be normalized through SASLprep. This is a deviation from the RFC5802 spec and is not recommended. =head1 METHODS =head2 first_msg $client_first_msg = $client->first_msg(); This takes no arguments and returns the C character string to be sent to the server to initiate a SCRAM session. Calling this again will reset the internal state and initiate a new session. This will throw an exception should an error occur. =head2 final_msg $client_final_msg = $client->final_msg( $server_first_msg ); This takes the C character string received from the server and returns the C character string containing the authentication proof to be sent to the server. This will throw an exception should an error occur. =head2 validate $client->validate( $server_final_msg ); This takes the C character string received from the server and verifies that the server actually has a copy of the client credentials. It will return true if valid and throw an exception, otherwise. =head2 computed_keys This method returns the opaque keys used in the SCRAM protocol. It returns the 'stored key', the 'client key' and the 'server key'. The server must have a copy of the stored key and server key for a given user in order to authenticate. This method caches the computed values -- it generates them fresh only if the supplied salt and iteration count don't match the cached salt and iteration count. =for Pod::Coverage BUILD =head1 CHARACTER ENCODING CAVEAT The SCRAM protocol mandates UTF-8 interchange. However, all methods in this module take and return B strings. You must encode to UTF-8 before sending and decode from UTF-8 on receiving according to whatever transport mechanism you are using. This is done to avoid double encoding/decoding problems if your transport is already doing UTF-8 encoding or decoding as it constructs outgoing messages or parses incoming messages. =head1 AUTHOR David Golden =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by David Golden. This is free software, licensed under: The Apache License, Version 2.0, January 2004 =head1 AUTHOR David Golden =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by David Golden. This is free software, licensed under: The Apache License, Version 2.0, January 2004 =cut Authen-SCRAM-0.011/lib/Authen/SCRAM/Role/Common.pm000644 000765 000024 00000016506 13313601310 021361 0ustar00davidstaff000000 000000 use 5.008; use strict; use warnings; package Authen::SCRAM::Role::Common; our $VERSION = '0.011'; use Moo::Role 1.001000; use Authen::SASL::SASLprep 1.100 qw/saslprep/; use Carp qw/croak/; use Crypt::URandom qw/urandom/; use Encode qw/encode_utf8/; use MIME::Base64 qw/encode_base64/; use PBKDF2::Tiny 0.003 qw/digest_fcn hmac/; use Try::Tiny; use Types::Standard qw/Bool Enum Num HashRef CodeRef/; use namespace::clean; #--------------------------------------------------------------------------# # public attributes #--------------------------------------------------------------------------# has digest => ( is => 'ro', isa => Enum [qw/SHA-1 SHA-224 SHA-256 SHA-384 SHA-512/], default => 'SHA-1', ); has nonce_size => ( is => 'ro', isa => Num, default => 192, ); has skip_saslprep => ( is => 'ro', isa => Bool, ); #--------------------------------------------------------------------------# # private attributes #--------------------------------------------------------------------------# has _const_eq_fcn => ( is => 'lazy', isa => CodeRef, ); # constant time comparison to avoid timing attacks; uses # String::Compare::ConstantTime if available or a pure-Perl fallback sub _build__const_eq_fcn { my ($self) = @_; # XXX disable String::Compare::ConstantTime until a new version # is released that fixes warnings on older perls. if ( 0 && eval { require String::Compare::ConstantTime; 1 } ) { return \&String::Compare::ConstantTime::equals; } else { return sub { my ( $dk1, $dk2 ) = @_; my $dk1_length = length($dk1); return unless $dk1_length == length($dk2); my $match = 1; for my $offset ( 0 .. $dk1_length ) { $match &= ( substr( $dk1, $offset, 1 ) eq substr( $dk2, $offset, 1 ) ) ? 1 : 0; } return $match; }; } } has _digest_fcn => ( is => 'lazy', isa => CodeRef, ); sub _build__digest_fcn { my ($self) = @_; my ($fcn) = digest_fcn( $self->digest ); return $fcn; } # _hmac_fcn( $key, $data ) -- this matches RFC 5802 parameter order but # is reversed from Digest::HMAC/PBKDF2::Tiny which uses (data, key) has _hmac_fcn => ( is => 'lazy', isa => CodeRef, ); sub _build__hmac_fcn { my ($self) = @_; my ( $fcn, $block_size, $digest_length ) = digest_fcn( $self->digest ); return sub { my ( $key, $data ) = @_; $key = $fcn->($key) if length($key) > $block_size; return hmac( $data, $key, $fcn, $block_size ); }; } # helpful for testing has _nonce_generator => ( is => 'lazy', isa => CodeRef, ); sub _build__nonce_generator { my ($self) = @_; # extract from $self to avoid circular reference my $nonce_size = $self->nonce_size; return sub { return encode_base64( urandom( $nonce_size / 8 ), "" ) }; } # _session builds up parameters used during a SCRAM session. Keys # starting with "_" are private state not used for exchange. Single # letter keys are defined as per RFC5802 # # _nonce private nonce part # _c1b client-first-message-bare # _s1 server-first-message # _c2wop client-final-message-without-proof # _stored_key H(ClientKey) # _server_key HMAC(SaltedPassword, "Server Key") # _auth AuthMessage has _session => ( is => 'lazy', isa => HashRef, clearer => 1, ); sub _build__session { my ($self) = @_; return { _nonce => $self->_nonce_generator->() }; } #--------------------------------------------------------------------------# # methods #--------------------------------------------------------------------------# sub _auth_msg { my ($self) = @_; return $self->_session->{_auth} ||= encode_utf8( join( ",", map { $self->_session->{$_} } qw/_c1b _s1 _c2wop/ ) ); } sub _base64 { my ( $self, $data ) = @_; return encode_base64( $data, "" ); } sub _client_sig { my ($self) = @_; return $self->_hmac_fcn->( $self->_session->{_stored_key}, $self->_auth_msg ); } sub _construct_gs2 { my ( $self, $authz ) = @_; my $maybe = ( defined($authz) && length($authz) ) ? ( "a=" . $self->_encode_name($authz) ) : ""; return "n,$maybe,"; } sub _decode_name { my ( $self, $name ) = @_; $name =~ s/=2c/,/g; $name =~ s/=3d/=/g; return $name; } sub _encode_name { my ( $self, $name ) = @_; $name =~ s/=/=3d/g; $name =~ s/,/=2c/g; return $name; } sub _extend_nonce { my ($self) = @_; $self->_session->{r} .= $self->_session->{_nonce}; } sub _get_session { my ( $self, $key ) = @_; return $self->_session->{$key}; } sub _join_reply { my ( $self, @fields ) = @_; my @reply; for my $k (@fields) { my $v = $self->_session->{$k}; if ( $k eq 'a' || $k eq 'n' ) { $v = $self->_encode_name($v); } push @reply, "$k=$v"; } my $msg = '' . join( ",", @reply ); utf8::upgrade($msg); return $msg; } sub _parse_to_session { my ( $self, @params ) = @_; for my $part (@params) { my ( $k, $v ) = split /=/, $part, 2; if ( $k eq 'a' || $k eq 'n' ) { $v = $self->_saslprep( $self->_decode_name($v) ); } elsif ( $k eq 'i' && $v !~ /^[0-9]+$/ ) { croak "SCRAM iteration parameter '$part' invalid"; } $self->_session->{$k} = $v; } return; } sub _saslprep { my ( $self, $name ) = @_; return $name if $self->skip_saslprep; my $prepped = try { saslprep( $name, 1 ); # '1' makes it use stored mode } catch { croak "SCRAM username '$name' invalid: $_"; }; return $prepped; } sub _set_session { my ( $self, %args ) = @_; while ( my ( $k, $v ) = each %args ) { $self->_session->{$k} = $v; } return; } #--------------------------------------------------------------------------# # regular expressions for parsing #--------------------------------------------------------------------------# # tokens my $VALUE = qr/[^,]+/; my $CBNAME = qr/[a-zA-Z0-9.-]+/; my $ATTR_VAL = qr/[a-zA-Z]=$VALUE/; # atoms my $GS2_CBIND_FLAG = qr/(?:n|y|p=$VALUE)/; my $AUTHZID = qr/a=$VALUE/; my $CHN_BIND = qr/c=$VALUE/; my $S_ERROR = qr/e=$VALUE/; my $ITER_CNT = qr/i=$VALUE/; my $MEXT = qr/m=$VALUE/; my $USERNAME = qr/n=$VALUE/; my $PROOF = qr/p=$VALUE/; my $NONCE = qr/r=$VALUE/; my $SALT = qr/s=$VALUE/; my $VERIFIER = qr/v=$VALUE/; my $EXT = qr/$ATTR_VAL (?: , $ATTR_VAL)*/; # constructions my $C_FRST_BARE = qr/(?:($MEXT),)? ($USERNAME) , ($NONCE) (?:,$EXT)?/x; my $GS2_HEADER = qr/($GS2_CBIND_FLAG) , ($AUTHZID)? , /x; my $C_FINL_WO_PRF = qr/($CHN_BIND) , ($NONCE) (?:,$EXT)?/x; # messages my $C_FRST_MSG = qr/$GS2_HEADER ($C_FRST_BARE)/x; my $S_FRST_MSG = qr/(?:($MEXT),)? ($NONCE) , ($SALT) , ($ITER_CNT) (?:,$EXT)?/x; my $C_FINL_MSG = qr/($C_FINL_WO_PRF) , ($PROOF)/x; my $S_FINL_MSG = qr/($S_ERROR | $VERIFIER)/x; sub _client_first_re { $C_FRST_MSG } # ($cbind, $authz?, $c_1_bare, $mext?, @params) sub _server_first_re { $S_FRST_MSG } # ($mext?, @params) sub _client_final_re { $C_FINL_MSG } # ($c_2_wo_proof, @params) sub _server_final_re { $S_FINL_MSG } # ($error_or_verification) 1; =pod =for Pod::Coverage digest nonce_size skip_saslprep =cut # vim: ts=4 sts=4 sw=4 et: Authen-SCRAM-0.011/xt/author/000755 000765 000024 00000000000 13313601310 015760 5ustar00davidstaff000000 000000 Authen-SCRAM-0.011/xt/release/000755 000765 000024 00000000000 13313601310 016076 5ustar00davidstaff000000 000000 Authen-SCRAM-0.011/xt/release/distmeta.t000644 000765 000024 00000000172 13313601310 020075 0ustar00davidstaff000000 000000 #!perl # This file was automatically generated by Dist::Zilla::Plugin::MetaTests. use Test::CPAN::Meta; meta_yaml_ok(); Authen-SCRAM-0.011/xt/author/critic.t000644 000765 000024 00000000201 13313601310 017413 0ustar00davidstaff000000 000000 #!perl use strict; use warnings; use Test::Perl::Critic (-profile => "perlcritic.rc") x!! -e "perlcritic.rc"; all_critic_ok(); Authen-SCRAM-0.011/xt/author/minimum-version.t000644 000765 000024 00000000130 13313601310 021275 0ustar00davidstaff000000 000000 #!perl use Test::More; use Test::MinimumVersion; all_minimum_version_ok( qq{5.010} ); Authen-SCRAM-0.011/xt/author/test-version.t000644 000765 000024 00000000637 13313601310 020615 0ustar00davidstaff000000 000000 use strict; use warnings; use Test::More; # generated by Dist::Zilla::Plugin::Test::Version 1.09 use Test::Version; my @imports = qw( version_all_ok ); my $params = { is_strict => 0, has_version => 1, multiple => 0, }; push @imports, $params if version->parse( $Test::Version::VERSION ) >= version->parse('1.002'); Test::Version->import(@imports); version_all_ok; done_testing; Authen-SCRAM-0.011/xt/author/00-compile.t000644 000765 000024 00000003020 13313601310 020005 0ustar00davidstaff000000 000000 use 5.006; use strict; use warnings; # this test was generated with Dist::Zilla::Plugin::Test::Compile 2.058 use Test::More; plan tests => 5; my @module_files = ( 'Authen/SCRAM.pm', 'Authen/SCRAM/Client.pm', 'Authen/SCRAM/Role/Common.pm', 'Authen/SCRAM/Server.pm' ); # fake home for cpan-testers use File::Temp; local $ENV{HOME} = File::Temp::tempdir( CLEANUP => 1 ); my @switches = ( -d 'blib' ? '-Mblib' : '-Ilib', ); use File::Spec; use IPC::Open3; use IO::Handle; open my $stdin, '<', File::Spec->devnull or die "can't open devnull: $!"; my @warnings; for my $lib (@module_files) { # see L my $stderr = IO::Handle->new; diag('Running: ', join(', ', map { my $str = $_; $str =~ s/'/\\'/g; q{'} . $str . q{'} } $^X, @switches, '-e', "require q[$lib]")) if $ENV{PERL_COMPILE_TEST_DEBUG}; my $pid = open3($stdin, '>&STDERR', $stderr, $^X, @switches, '-e', "require q[$lib]"); binmode $stderr, ':crlf' if $^O eq 'MSWin32'; my @_warnings = <$stderr>; waitpid($pid, 0); is($?, 0, "$lib loaded ok"); shift @_warnings if @_warnings and $_warnings[0] =~ /^Using .*\bblib/ and not eval { +require blib; blib->VERSION('1.01') }; if (@_warnings) { warn @_warnings; push @warnings, @_warnings; } } is(scalar(@warnings), 0, 'no warnings found') or diag 'got warnings: ', ( Test::More->can('explain') ? Test::More::explain(\@warnings) : join("\n", '', @warnings) ); Authen-SCRAM-0.011/xt/author/pod-syntax.t000644 000765 000024 00000000252 13313601310 020252 0ustar00davidstaff000000 000000 #!perl # This file was automatically generated by Dist::Zilla::Plugin::PodSyntaxTests. use strict; use warnings; use Test::More; use Test::Pod 1.41; all_pod_files_ok(); Authen-SCRAM-0.011/xt/author/portability.t000644 000765 000024 00000000322 13313601310 020504 0ustar00davidstaff000000 000000 use strict; use warnings; use Test::More; eval 'use Test::Portability::Files'; plan skip_all => 'Test::Portability::Files required for testing portability' if $@; options(test_one_dot => 0); run_tests(); Authen-SCRAM-0.011/xt/author/pod-spell.t000644 000765 000024 00000000462 13313601310 020046 0ustar00davidstaff000000 000000 use strict; use warnings; use Test::More; # generated by Dist::Zilla::Plugin::Test::PodSpelling 2.007005 use Test::Spelling 0.12; use Pod::Wordlist; add_stopwords(); all_pod_files_spelling_ok( qw( bin lib ) ); __DATA__ Authen Client Common David Golden Role SASLprep SCRAM Server dagolden lib xdg Authen-SCRAM-0.011/xt/author/pod-coverage.t000644 000765 000024 00000000334 13313601310 020520 0ustar00davidstaff000000 000000 #!perl # This file was automatically generated by Dist::Zilla::Plugin::PodCoverageTests. use Test::Pod::Coverage 1.08; use Pod::Coverage::TrustPod; all_pod_coverage_ok({ coverage_class => 'Pod::Coverage::TrustPod' }); Authen-SCRAM-0.011/t/client.t000644 000765 000024 00000014630 13313601310 015735 0ustar00davidstaff000000 000000 use 5.008001; use strict; use warnings; use Test::More 0.96; use Test::FailWarnings -allow_deps => 1; use Test::Fatal; binmode( Test::More->builder->$_, ":utf8" ) for qw/output failure_output todo_output/; use lib 't/lib'; use TestSCRAM qw/get_client/; require_ok("Authen::SCRAM::Client"); subtest "constructors" => sub { my $client = get_client; is( $client->digest, 'SHA-1', "default digest" ); is( $client->username, 'user', "username attribute" ); is( $client->password, 'pencil', "password attribute" ); is( $client->nonce_size, 192, "nonce size attribute" ); for my $d (qw/1 224 256 384 512/) { my $obj = get_client( username => 'user', password => 'pencil', digest => "SHA-$d" ); is( $obj->digest, "SHA-$d", "digest set correctly to SHA-$d" ); } }; subtest "client first message" => sub { my $client = get_client; like( my $first = $client->first_msg, qr{^n,,n=user,r=[a-zA-Z0-9+/=]{32}$}, "message structure" ); isnt( $first, $client->first_msg, "repeat calls are different" ); like( get_client( username => 'us,e=r' )->first_msg, qr{^n,,n=us=2ce=3dr}, "user name , and = encoding" ); like( get_client( authorization_id => 'other,me' )->first_msg, qr{^n,a=other=2cme,n=user,r=.+}, "authorization_id with encoding" ); }; subtest "RFC 5802 example" => sub { # force client nonce to match RFC5802 example my $client = get_client( _nonce_generator => sub { "fyko+d2lbbFgONRv9qkxdawL" } ); my $first = $client->first_msg(); is( $first, "n,,n=user,r=fyko+d2lbbFgONRv9qkxdawL", "client first message" ) or diag explain $client; # RFC5802 example server-first-message my $server_first = "r=fyko+d2lbbFgONRv9qkxdawL3rfcNHYJY1ZVvWVs7j,s=QSXCR+Q6sek8bf92,i=4096"; my $final = $client->final_msg($server_first); is( $final, "c=biws,r=fyko+d2lbbFgONRv9qkxdawL3rfcNHYJY1ZVvWVs7j,p=v0X8v3Bz2T0CJGbJQyF0X+HI4Ts=", "client final message" ) or diag explain $client; ok( $client->validate("v=rmF9pqV8S7suAoZWja4dJRkFsKQ="), "server message validated" ); # Repeat to check credential caching by hooking the digest method, # which is called to pass to 'derive'. { no warnings 'redefine'; my $digest_called; my $orig = \&Authen::SCRAM::Client::digest; local *Authen::SCRAM::Client::digest = sub { $digest_called = 1; &$orig; }; # Reuse earlier client (recall that nonce is forced constant) my $first = $client->first_msg(); is( $first, "n,,n=user,r=fyko+d2lbbFgONRv9qkxdawL", "client first message" ) or diag explain $client; # RFC5802 example server-first-message my $server_first = "r=fyko+d2lbbFgONRv9qkxdawL3rfcNHYJY1ZVvWVs7j,s=QSXCR+Q6sek8bf92,i=4096"; my $final = $client->final_msg($server_first); is( $final, "c=biws,r=fyko+d2lbbFgONRv9qkxdawL3rfcNHYJY1ZVvWVs7j,p=v0X8v3Bz2T0CJGbJQyF0X+HI4Ts=", "client final message" ) or diag explain $client; ok( !$digest_called, "cached credentials used" ); } }; subtest "RFC 7677 example (SHA256)" => sub { # force client nonce to match RFC7677 example my $client = get_client( digest => 'SHA-256', _nonce_generator => sub { "rOprNGfwEbeRWgbNEkqO" } ); my $first = $client->first_msg(); is( $first, "n,,n=user,r=rOprNGfwEbeRWgbNEkqO", "client first message" ) or diag explain $client; # RFC7677 example server-first-message my $server_first = 'r=rOprNGfwEbeRWgbNEkqO%hvYDpWUa2RaTCAfuxFIlj)hNlF$k0,s=W22ZaJ0SNY7soEsUEjb6gQ==,i=4096'; my $final = $client->final_msg($server_first); is( $final, 'c=biws,r=rOprNGfwEbeRWgbNEkqO%hvYDpWUa2RaTCAfuxFIlj)hNlF$k0,p=dHzbZapWIk4jUhN+Ute9ytag9zjfMHgsqmmiz7AndVQ=', "client final message" ) or diag explain $client; ok( $client->validate("v=6rriTRBi23WpRR/wtup+mMhUZUn/dB5nLTJRsjl95G4="), "server message validated" ); }; subtest "Unicode username" => sub { my $client = get_client( username => "ram\N{U+00F3}n", password => "p\N{U+00C5}ssword", _nonce_generator => sub { "cT4Z0nGchlcAXXkDBrYFlC7b3bXA24xr" } ); my $first = $client->first_msg(); is( $first, "n,,n=ram\N{U+00F3}n,r=cT4Z0nGchlcAXXkDBrYFlC7b3bXA24xr", "client first message" ) or diag explain $client; my $server_first = "r=cT4Z0nGchlcAXXkDBrYFlC7b3bXA24xrB3rw8xNSLYx23V0qdkD/t7ZjoUcyDrTy,s=c2FsdA==,i=4096"; my $final = $client->final_msg($server_first); is( $final, 'c=biws,r=cT4Z0nGchlcAXXkDBrYFlC7b3bXA24xrB3rw8xNSLYx23V0qdkD/t7ZjoUcyDrTy,p=lfZL47BCT5wdBisDystprtNLsbA=', "client final message" ) or diag explain $client; ok( $client->validate("v=etGS4QFClYMJTMeRBMs0lnWRmV8="), "server message validated" ); }; subtest "Minimum iteration count" => sub { { # force client nonce to match RFC5802 example my $client = get_client( _nonce_generator => sub { "fyko+d2lbbFgONRv9qkxdawL" } ); my $first = $client->first_msg(); # RFC5802 example server-first-message, with too low iteration count my $server_first = "r=fyko+d2lbbFgONRv9qkxdawL3rfcNHYJY1ZVvWVs7j,s=QSXCR+Q6sek8bf92,i=4095"; like( exception { $client->final_msg($server_first) }, qr/requested 4095 iterations, less than/, "Default iteration count" ); } { # force client nonce to match RFC5802 example my $client = get_client( _nonce_generator => sub { "fyko+d2lbbFgONRv9qkxdawL" }, minimum_iteration_count => 8192 ); my $first = $client->first_msg(); # RFC5802 example server-first-message, with too low iteration count my $server_first = "r=fyko+d2lbbFgONRv9qkxdawL3rfcNHYJY1ZVvWVs7j,s=QSXCR+Q6sek8bf92,i=8191"; like( exception { $client->final_msg($server_first) }, qr/requested 8191 iterations, less than/, "Custom iteration count" ); } }; done_testing; # # This file is part of Authen-SCRAM # # This software is Copyright (c) 2014 by David Golden. # # This is free software, licensed under: # # The Apache License, Version 2.0, January 2004 # # vim: ts=4 sts=4 sw=4 et: Authen-SCRAM-0.011/t/errors.t000644 000765 000024 00000006203 13313601310 015770 0ustar00davidstaff000000 000000 use 5.008001; use strict; use warnings; use Test::More 0.96; use Test::FailWarnings -allow_deps => 1; use Test::Fatal; binmode( Test::More->builder->$_, ":utf8" ) for qw/output failure_output todo_output/; use lib 't/lib'; use TestSCRAM qw/get_client get_server/; subtest "constructors" => sub { like( exception { get_client( digest => 'MD5' ) }, qr/did not pass type constraint/, "client: bad digest type throws exception" ); like( exception { get_server( digest => 'MD5' ) }, qr/did not pass type constraint/, "server: bad digest type throws exception" ); }; subtest "bad client first message" => sub { my $server = get_server; #<<< No perltidy my @bad_messages = ( '', 'n,,', ',,n=user,r=salt', 'x,,n=user,r=salt', 'n,,user', 'n,,=user', 'n,,n=user', 'n,,a=b,c=d,d=3', 'n,,r=salt,n=user', ); #>>> for my $bad (@bad_messages) { like( exception { $server->first_msg($bad) }, qr/SCRAM client-first-message could not be parsed/, "parse error: <$bad>", ); } }; subtest "bad server first message" => sub { my $client = get_client( _nonce_generator => sub { "fyko+d2lbbFgONRv9qkxdawL" } ); $client->first_msg; my $nonce = $client->_session->{r}; #<<< No perltidy my @bad_messages = ( '', ",r=${nonce}abc,i=99", "r=${nonce}abc,s=dlkfakdf", "r=${nonce}abc,s=dlkfakdf,i=", "r=${nonce}abc,i=1000,s=dsfadks", ); #>>> for my $bad (@bad_messages) { $client->first_msg; like( exception { $client->final_msg($bad) }, qr/SCRAM server-first-message could not be parsed/, "parse error: <$bad>", ); } #<<< No perltidy my @bad_nonce = ( "r=sadkasdllk,s=akdjad,i=99", "r=$nonce,s=akdjad,i=99", ); #>>> for my $bad (@bad_nonce) { $client->first_msg; like( exception { $client->final_msg($bad) }, qr/SCRAM server-first-message nonce invalid/, "nonce error: <$bad>", ); } #<<< No perltidy my @bad_iters = ( "r=${nonce}abc,s=def,i=-1000", "r=${nonce}abc,s=def,i=-1.00", "r=${nonce}abc,s=def,i=afdkj", ); #>>> for my $bad (@bad_iters) { $client->first_msg; like( exception { $client->final_msg($bad) }, qr/SCRAM iteration parameter '[^']+' invalid/, "iterator error: <$bad>", ); } }; subtest "unsupported features" => sub { my $client = get_client; $client->first_msg; like( exception { $client->final_msg("m=1234,r=adlskjas,s=ldkjfalfdj,i=1000") }, qr/mandatory extension 'm=1234', but we do not support it/, "mandatory extension receiving server-first-message", ); }; done_testing; # # This file is part of Authen-SCRAM # # This software is Copyright (c) 2014 by David Golden. # # This is free software, licensed under: # # The Apache License, Version 2.0, January 2004 # # vim: ts=4 sts=4 sw=4 et: Authen-SCRAM-0.011/t/00-report-prereqs.t000644 000765 000024 00000013426 13313601310 017670 0ustar00davidstaff000000 000000 #!perl use strict; use warnings; # This test was generated by Dist::Zilla::Plugin::Test::ReportPrereqs 0.027 use Test::More tests => 1; use ExtUtils::MakeMaker; use File::Spec; # from $version::LAX my $lax_version_re = qr/(?: undef | (?: (?:[0-9]+) (?: \. | (?:\.[0-9]+) (?:_[0-9]+)? )? | (?:\.[0-9]+) (?:_[0-9]+)? ) | (?: v (?:[0-9]+) (?: (?:\.[0-9]+)+ (?:_[0-9]+)? )? | (?:[0-9]+)? (?:\.[0-9]+){2,} (?:_[0-9]+)? ) )/x; # hide optional CPAN::Meta modules from prereq scanner # and check if they are available my $cpan_meta = "CPAN::Meta"; my $cpan_meta_pre = "CPAN::Meta::Prereqs"; my $HAS_CPAN_META = eval "require $cpan_meta; $cpan_meta->VERSION('2.120900')" && eval "require $cpan_meta_pre"; ## no critic # Verify requirements? my $DO_VERIFY_PREREQS = 1; sub _max { my $max = shift; $max = ( $_ > $max ) ? $_ : $max for @_; return $max; } sub _merge_prereqs { my ($collector, $prereqs) = @_; # CPAN::Meta::Prereqs object if (ref $collector eq $cpan_meta_pre) { return $collector->with_merged_prereqs( CPAN::Meta::Prereqs->new( $prereqs ) ); } # Raw hashrefs for my $phase ( keys %$prereqs ) { for my $type ( keys %{ $prereqs->{$phase} } ) { for my $module ( keys %{ $prereqs->{$phase}{$type} } ) { $collector->{$phase}{$type}{$module} = $prereqs->{$phase}{$type}{$module}; } } } return $collector; } my @include = qw( ); my @exclude = qw( ); # Add static prereqs to the included modules list my $static_prereqs = do './t/00-report-prereqs.dd'; # Merge all prereqs (either with ::Prereqs or a hashref) my $full_prereqs = _merge_prereqs( ( $HAS_CPAN_META ? $cpan_meta_pre->new : {} ), $static_prereqs ); # Add dynamic prereqs to the included modules list (if we can) my ($source) = grep { -f } 'MYMETA.json', 'MYMETA.yml'; my $cpan_meta_error; if ( $source && $HAS_CPAN_META && (my $meta = eval { CPAN::Meta->load_file($source) } ) ) { $full_prereqs = _merge_prereqs($full_prereqs, $meta->prereqs); } else { $cpan_meta_error = $@; # capture error from CPAN::Meta->load_file($source) $source = 'static metadata'; } my @full_reports; my @dep_errors; my $req_hash = $HAS_CPAN_META ? $full_prereqs->as_string_hash : $full_prereqs; # Add static includes into a fake section for my $mod (@include) { $req_hash->{other}{modules}{$mod} = 0; } for my $phase ( qw(configure build test runtime develop other) ) { next unless $req_hash->{$phase}; next if ($phase eq 'develop' and not $ENV{AUTHOR_TESTING}); for my $type ( qw(requires recommends suggests conflicts modules) ) { next unless $req_hash->{$phase}{$type}; my $title = ucfirst($phase).' '.ucfirst($type); my @reports = [qw/Module Want Have/]; for my $mod ( sort keys %{ $req_hash->{$phase}{$type} } ) { next if $mod eq 'perl'; next if grep { $_ eq $mod } @exclude; my $file = $mod; $file =~ s{::}{/}g; $file .= ".pm"; my ($prefix) = grep { -e File::Spec->catfile($_, $file) } @INC; my $want = $req_hash->{$phase}{$type}{$mod}; $want = "undef" unless defined $want; $want = "any" if !$want && $want == 0; my $req_string = $want eq 'any' ? 'any version required' : "version '$want' required"; if ($prefix) { my $have = MM->parse_version( File::Spec->catfile($prefix, $file) ); $have = "undef" unless defined $have; push @reports, [$mod, $want, $have]; if ( $DO_VERIFY_PREREQS && $HAS_CPAN_META && $type eq 'requires' ) { if ( $have !~ /\A$lax_version_re\z/ ) { push @dep_errors, "$mod version '$have' cannot be parsed ($req_string)"; } elsif ( ! $full_prereqs->requirements_for( $phase, $type )->accepts_module( $mod => $have ) ) { push @dep_errors, "$mod version '$have' is not in required range '$want'"; } } } else { push @reports, [$mod, $want, "missing"]; if ( $DO_VERIFY_PREREQS && $type eq 'requires' ) { push @dep_errors, "$mod is not installed ($req_string)"; } } } if ( @reports ) { push @full_reports, "=== $title ===\n\n"; my $ml = _max( map { length $_->[0] } @reports ); my $wl = _max( map { length $_->[1] } @reports ); my $hl = _max( map { length $_->[2] } @reports ); if ($type eq 'modules') { splice @reports, 1, 0, ["-" x $ml, "", "-" x $hl]; push @full_reports, map { sprintf(" %*s %*s\n", -$ml, $_->[0], $hl, $_->[2]) } @reports; } else { splice @reports, 1, 0, ["-" x $ml, "-" x $wl, "-" x $hl]; push @full_reports, map { sprintf(" %*s %*s %*s\n", -$ml, $_->[0], $wl, $_->[1], $hl, $_->[2]) } @reports; } push @full_reports, "\n"; } } } if ( @full_reports ) { diag "\nVersions for all modules listed in $source (including optional ones):\n\n", @full_reports; } if ( $cpan_meta_error || @dep_errors ) { diag "\n*** WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING ***\n"; } if ( $cpan_meta_error ) { my ($orig_source) = grep { -f } 'MYMETA.json', 'MYMETA.yml'; diag "\nCPAN::Meta->load_file('$orig_source') failed with: $cpan_meta_error\n"; } if ( @dep_errors ) { diag join("\n", "\nThe following REQUIRED prerequisites were not satisfied:\n", @dep_errors, "\n" ); } pass; # vim: ts=4 sts=4 sw=4 et: Authen-SCRAM-0.011/t/lib/000755 000765 000024 00000000000 13313601310 015034 5ustar00davidstaff000000 000000 Authen-SCRAM-0.011/t/round_trip.t000644 000765 000024 00000012430 13313601310 016640 0ustar00davidstaff000000 000000 use 5.008001; use strict; use warnings; use Test::More 0.96; use Test::FailWarnings -allow_deps => 1; use Test::Fatal; binmode( Test::More->builder->$_, ":utf8" ) for qw/output failure_output todo_output/; use lib 't/lib'; use TestSCRAM qw/get_client get_server/; subtest "RFC 5802 example" => sub { my $client = get_client( _nonce_generator => sub { "fyko+d2lbbFgONRv9qkxdawL" } ); my $server = get_server; my ( $c1, $c2, $s1, $s2 ); is( exception { $c1 = $client->first_msg() }, undef, "client first message" ); is( exception { $s1 = $server->first_msg($c1) }, undef, "server first message" ); is( exception { $c2 = $client->final_msg($s1) }, undef, "client final message" ); is( exception { $s2 = $server->final_msg($c2) }, undef, "server final message" ); is( exception { $client->validate($s2) }, undef, "client validation" ); is( $server->authorization_id, 'user', "server authz" ); }; subtest "generated example" => sub { my $client = get_client( username => 'johndoe', password => 'passPASSpass' ); my $server = get_server; my ( $c1, $c2, $s1, $s2 ); is( exception { $c1 = $client->first_msg() }, undef, "client first message" ); is( exception { $s1 = $server->first_msg($c1) }, undef, "server first message" ); is( exception { $c2 = $client->final_msg($s1) }, undef, "client final message" ); is( exception { $s2 = $server->final_msg($c2) }, undef, "server final message" ); is( exception { $client->validate($s2) }, undef, "client validation" ); is( $server->authorization_id, 'johndoe', "server authz" ); }; subtest "generated example with authz" => sub { my $client = get_client( username => 'johndoe', password => 'passPASSpass', authorization_id => 'admin' ); my $server = get_server; my ( $c1, $c2, $s1, $s2 ); is( exception { $c1 = $client->first_msg() }, undef, "client first message" ); is( exception { $s1 = $server->first_msg($c1) }, undef, "server first message" ); is( exception { $c2 = $client->final_msg($s1) }, undef, "client final message" ); is( exception { $s2 = $server->final_msg($c2) }, undef, "server final message" ); is( exception { $client->validate($s2) }, undef, "client validation" ); is( $server->authorization_id, 'admin', "server authz" ); }; subtest "generated example with Unicode user/pass/authz" => sub { my $client = get_client( username => "johnd\N{U+110B}oe", password => "pass\N{U+110B}PASSpass", authorization_id => "admi\N{U+110B}n" ); my $server = get_server; my ( $c1, $c2, $s1, $s2 ); is( exception { $c1 = $client->first_msg() }, undef, "client first message" ); is( exception { $s1 = $server->first_msg($c1) }, undef, "server first message" ); is( exception { $c2 = $client->final_msg($s1) }, undef, "client final message" ); is( exception { $s2 = $server->final_msg($c2) }, undef, "server final message" ); is( exception { $client->validate($s2) }, undef, "client validation" ); is( $server->authorization_id, "admi\N{U+110B}n", "server authz" ); }; subtest "generated example with bad user" => sub { my $client = get_client( username => 'janedoe', password => 'password', ); my $server = get_server; my ( $c1, $c2, $s1, $s2 ); is( exception { $c1 = $client->first_msg() }, undef, "client first message" ); like( exception { $s1 = $server->first_msg($c1) }, qr/unknown user 'janedoe'/, "auth fails for unknown user" ); is( $server->authorization_id, '', "server authz empty after error" ); }; subtest "generated example with bad password" => sub { my $client = get_client( username => 'johndoe', password => 'not the right one', ); my $server = get_server; my ( $c1, $c2, $s1, $s2 ); is( exception { $c1 = $client->first_msg() }, undef, "client first message" ); is( exception { $s1 = $server->first_msg($c1) }, undef, "server first message" ); is( exception { $c2 = $client->final_msg($s1) }, undef, "client final message" ); like( exception { $s2 = $server->final_msg($c2) }, qr/authentication for user 'johndoe' failed/, "auth fails for bad password" ); is( $server->authorization_id, '', "server authz empty after error" ); }; subtest "generated example with failed authz" => sub { my $client = get_client( username => 'johndoe', password => 'passPASSpass', authorization_id => 'johnmac' ); my $server = get_server; my ( $c1, $c2, $s1, $s2 ); is( exception { $c1 = $client->first_msg() }, undef, "client first message" ); is( exception { $s1 = $server->first_msg($c1) }, undef, "server first message" ); is( exception { $c2 = $client->final_msg($s1) }, undef, "client final message" ); like( exception { $s2 = $server->final_msg($c2) }, qr/not authorized to act as/, "proxy auth not allowed" ); is( $server->authorization_id, '', "server authz empty after error" ); }; done_testing; # # This file is part of Authen-SCRAM # # This software is Copyright (c) 2014 by David Golden. # # This is free software, licensed under: # # The Apache License, Version 2.0, January 2004 # # vim: ts=4 sts=4 sw=4 et: Authen-SCRAM-0.011/t/00-report-prereqs.dd000644 000765 000024 00000006663 13313601310 020021 0ustar00davidstaff000000 000000 do { my $x = { 'configure' => { 'requires' => { 'ExtUtils::MakeMaker' => '6.17', 'perl' => '5.008' } }, 'develop' => { 'requires' => { 'Dist::Zilla' => '5', 'Dist::Zilla::Plugin::RemovePrereqs' => '0', 'Dist::Zilla::Plugin::SurgicalPodWeaver' => '0.0021', 'Dist::Zilla::PluginBundle::DAGOLDEN' => '0.061', 'File::Spec' => '0', 'File::Temp' => '0', 'IO::Handle' => '0', 'IPC::Open3' => '0', 'Pod::Coverage::TrustPod' => '0', 'Pod::Wordlist' => '0', 'Software::License::Apache_2_0' => '0', 'Test::CPAN::Meta' => '0', 'Test::MinimumVersion' => '0', 'Test::More' => '0', 'Test::Perl::Critic' => '0', 'Test::Pod' => '1.41', 'Test::Pod::Coverage' => '1.08', 'Test::Portability::Files' => '0', 'Test::Spelling' => '0.12', 'Test::Version' => '1' } }, 'runtime' => { 'requires' => { 'Authen::SASL::SASLprep' => '1.100', 'Carp' => '0', 'Crypt::URandom' => '0', 'Encode' => '0', 'MIME::Base64' => '0', 'Moo' => '1.001000', 'Moo::Role' => '1.001000', 'PBKDF2::Tiny' => '0.003', 'Try::Tiny' => '0', 'Types::Standard' => '0', 'namespace::clean' => '0', 'perl' => '5.008001', 'strict' => '0', 'warnings' => '0' } }, 'test' => { 'recommends' => { 'CPAN::Meta' => '2.120900' }, 'requires' => { 'Exporter' => '0', 'ExtUtils::MakeMaker' => '0', 'File::Spec' => '0', 'Test::FailWarnings' => '0', 'Test::Fatal' => '0', 'Test::More' => '0.96', 'base' => '0', 'lib' => '0', 'perl' => '5.008001' } } }; $x; }Authen-SCRAM-0.011/t/server.t000644 000765 000024 00000003177 13313601310 015771 0ustar00davidstaff000000 000000 use 5.008001; use strict; use warnings; use Test::More 0.96; use Test::FailWarnings -allow_deps => 1; use Test::Fatal; binmode( Test::More->builder->$_, ":utf8" ) for qw/output failure_output todo_output/; use lib 't/lib'; use TestSCRAM qw/get_server/; require_ok("Authen::SCRAM::Server"); subtest "constructors" => sub { my $server = get_server; is( $server->digest, 'SHA-1', "default digest" ); is( $server->nonce_size, 192, "nonce size attribute" ); for my $d (qw/1 224 256 384 512/) { my $obj = get_server( digest => "SHA-$d" ); is( $obj->digest, "SHA-$d", "digest set correctly to SHA-$d" ); } }; subtest "RFC 5802 example" => sub { # force server nonce to match RFC5802 example my $server = get_server( _nonce_generator => sub { "3rfcNHYJY1ZVvWVs7j" } ); my $result = $server->first_msg("n,,n=user,r=fyko+d2lbbFgONRv9qkxdawL"); is( $result, "r=fyko+d2lbbFgONRv9qkxdawL3rfcNHYJY1ZVvWVs7j,s=QSXCR+Q6sek8bf92,i=4096", "RFC 5802 example server first message", ); my $final = $server->final_msg( "c=biws,r=fyko+d2lbbFgONRv9qkxdawL3rfcNHYJY1ZVvWVs7j,p=v0X8v3Bz2T0CJGbJQyF0X+HI4Ts=" ); is( $final, "v=rmF9pqV8S7suAoZWja4dJRkFsKQ=", "RFC 5802 example server final message", ); is( $server->authorization_id, 'user', "RFC 5802 example user authentication successful" ); }; done_testing; # # This file is part of Authen-SCRAM # # This software is Copyright (c) 2014 by David Golden. # # This is free software, licensed under: # # The Apache License, Version 2.0, January 2004 # # vim: ts=4 sts=4 sw=4 et: Authen-SCRAM-0.011/t/lib/TestSCRAM.pm000644 000765 000024 00000003700 13313601310 017077 0ustar00davidstaff000000 000000 use 5.008001; use strict; use warnings; package TestSCRAM; use Encode qw/encode_utf8/; use MIME::Base64 qw/decode_base64/; use PBKDF2::Tiny qw/derive digest_fcn hmac/; use base 'Exporter'; our @EXPORT = qw/get_client get_server get_cred check_proxy/; my ( $sha1, $sha1_block ) = digest_fcn('SHA-1'); # username => [ base64-salt, password, iterations ] # entry 'user' matches example from RFC 5802 my %CRED_INPUTS = ( user => [ 'QSXCR+Q6sek8bf92', 'pencil', 4096 ], johndoe => [ 'saltSALTsaltSALT', 'passPASSpass', 4096 ], "johnd\N{U+110B}oe" => [ 'salt', "pass\N{U+110B}PASSpass", 4096 ], ); # username => [ salt, stored key, server key, iterations ]; my %CRED; for my $user ( keys %CRED_INPUTS ) { my ( $salt, $pw, $i ) = @{ $CRED_INPUTS{$user} }; $salt = decode_base64($salt); my $salted_password = derive( 'SHA-1', encode_utf8($pw), $salt, $i ); my $client_key = _hmac( $salted_password, "Client Key" ); my $stored_key = $sha1->($client_key); my $server_key = _hmac( $salted_password, "Server Key" ); $CRED{$user} = [ $salt, $stored_key, $server_key, $i ]; } # username (can act as) authz_id my %VALID_PROXY = ( johndoe => 'admin', "johnd\N{U+110B}oe" => "admi\N{U+110B}n" ); sub _hmac { my ( $key, $data ) = @_; $key = $sha1->($key) if length($key) > $sha1_block; return hmac( $data, $key, $sha1, $sha1_block ); } sub check_proxy { my ( $user, $authz ) = @_; return ( ( $VALID_PROXY{$user} || '' ) eq $authz ); } sub get_cred { my $user = shift; return @{ $CRED{$user} || [] }; } sub get_client { require Authen::SCRAM::Client; return Authen::SCRAM::Client->new( username => 'user', password => 'pencil', @_ ); } sub get_server { require Authen::SCRAM::Server; return Authen::SCRAM::Server->new( credential_cb => \&get_cred, auth_proxy_cb => \&check_proxy, @_ ); } 1; Authen-SCRAM-0.011/devel/scram-examples.pl000644 000765 000024 00000010534 13313601310 020403 0ustar00davidstaff000000 000000 #!/usr/bin/env perl use v5.10; use strict; use warnings; use utf8; use open qw/:std :utf8/; use charnames ':full'; use Authen::SCRAM::Client; use Authen::SCRAM::Server; use Authen::SASL::SASLprep 1.100 qw/saslprep/; use JSON::MaybeXS; use MIME::Base64 qw/encode_base64/; use Tie::IxHash; use Path::Tiny; my $JSON = JSON::MaybeXS->new( ascii => 1, canonical => 1, pretty => 1 ); my @common = ( iters => 4096, salt => "saltSALTsalt", clientNonce => "clientNONCE", serverNonce => "serverNONCE", ); my @CRED_INPUTS = ( { label => "ASCII", user => "user", pass => "pencil", @common, }, { label => "ASCII user", user => "user", pass => "p\N{U+00E8}ncil", @common, }, { label => "ASCII pass", user => "ram\N{U+00F5}n", pass => "pencil", @common, }, { label => "SASLprep normal", user => "ram\N{U+00F5}n", pass => "p\N{U+00C5}assword", @common, }, { label => "SASLprep non-normal", user => "ramo\N{U+0301}n", pass => "p\N{U+212B}ssword", @common, }, { label => "no-SASLprep", user => "ramo\N{U+0301}n", pass => "p\N{U+212B}ssword", skipSASLprep => 1, @common, }, ); sub nice_string { join( "", map { $_ > 127 # if above ASCII ? sprintf( "\\u%04x", $_ ) # JSON-style escapes : chr($_) # else as themselves } unpack( "W*", $_[0] ) ); # unpack Unicode characters } for my $digest_name (qw/SHA-1 SHA-256/) { for my $c (@CRED_INPUTS) { my $cred = {%$c}; my $label = $cred->{label} = "$digest_name $cred->{label}"; my $niceuser = nice_string( $cred->{user} ); my $nicepass = nice_string( $cred->{pass} ); say "Test Case: $label"; say "User: '$niceuser'"; say "Pass: '$nicepass'"; my $client = Authen::SCRAM::Client->new( digest => $digest_name, username => $cred->{user}, password => $cred->{pass}, skip_saslprep => $cred->{skipSASLprep}, _nonce_generator => sub { $cred->{clientNonce} }, ); my ( $stored_key, $client_key, $server_key ) = $client->computed_keys( $cred->{salt}, $cred->{iters} ); my $prepped_user = saslprep( $cred->{user}, 1 ); my $prepped_pass = saslprep( $cred->{pass}, 1 ); if ( !$cred->{skipSASLprep} ) { say "Prepped User: '" . nice_string($prepped_user) . "'"; say "Prepped Pass '" . nice_string($prepped_pass) . "'"; } my $server = Authen::SCRAM::Server->new( digest => $digest_name, credential_cb => sub { my $user = shift; if ( $user eq $prepped_user ) { return ( $cred->{salt}, $stored_key, $server_key, $cred->{iters} ); } else { warn "BAD USERNAME MATCH FOR '$user'\n"; return; } }, _nonce_generator => sub { $cred->{serverNonce} }, ); my ( $c1, $c2, $s1, $s2 ); say "C1: " . nice_string( $c1 = $client->first_msg() ); say "S1: " . nice_string( $s1 = $server->first_msg($c1) ); say "C2: " . nice_string( $c2 = $client->final_msg($s1) ); say "S2: " . nice_string( $s2 = $server->final_msg($c2) ); $cred->{steps} = [ $c1, $s1, $c2, $s2, "" ]; say eval { $cred->{valid} = $client->validate($s2) ? \1 : \0; 1 } ? "Server: valid" : "Server: invalid"; say ""; $cred->{salt64} = encode_base64( delete $cred->{salt} ); $cred->{authID} = ""; $cred->{skipSASLprep} = $cred->{skipSASLprep} ? \1 : \0; $cred->{digest} = $digest_name; tie my %thash, "Tie::IxHash"; for my $k ( qw/label digest user pass authID skipSASLprep salt64 iters clientNonce serverNonce valid steps/ ) { $thash{$k} = $cred->{$k}; } my $fname = lc "$label.json"; $fname =~ tr[ ][-]; path($fname)->spew( $JSON->encode( \%thash ) ); } }