Authen-SASL-2.1900000755001750001750 015044402605 12640 5ustar00erikerik000000000000README100644001750001750 151715044402605 13605 0ustar00erikerik000000000000Authen-SASL-2.1900Authen::SASL - SASL Authentication framework DESCRIPTION ----------- SASL is a generic mechanism for authentication used by several network protocols. Authen::SASL provides an implementation framework that all protocols should be able to share. PREREQUISITES ------------- The following modules must already be installed before attempting to build Authen::SASL: * Perl, at least version 5.14.0, with its standard modules: * Digest::MD5 * JSON::PP * Test::More (for running tests only) * Crypt::URandom * Digest::HMAC_MD5 * GSSAPI (optional; for Kerberos v5 support) INSTALLING ---------- Once the prerequisites are met the module is built and installed in the standard manner: perl Makefile.PL make make test make install Depending on how perl is set up, the last step above may require elevated privileges. LICENSE100644001750001750 4651215044402605 13756 0ustar00erikerik000000000000Authen-SASL-2.1900This software is copyright (c) 2025 by Graham Barr . This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Terms of the Perl programming language system itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" --- The GNU General Public License, Version 1, February 1989 --- This software is Copyright (c) 2025 by Graham Barr . This is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The license agreements of most software companies try to keep users at the mercy of those companies. By contrast, our General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. The General Public License applies to the Free Software Foundation's software and to any other program whose authors commit to using it. You can use it for your programs, too. When we speak of free software, we are referring to freedom, not price. Specifically, the General Public License is designed to make sure that you have the freedom to give away or sell copies of free software, that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of a such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any work containing the Program or a portion of it, either verbatim or with modifications. Each licensee is addressed as "you". 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this General Public License and to the absence of any warranty; and give any other recipients of the Program a copy of this General Public License along with the Program. You may charge a fee for the physical act of transferring a copy. 2. You may modify your copy or copies of the Program or any portion of it, and copy and distribute such modifications under the terms of Paragraph 1 above, provided that you also do the following: a) cause the modified files to carry prominent notices stating that you changed the files and the date of any change; and b) cause the whole of any work that you distribute or publish, that in whole or in part contains the Program or any part thereof, either with or without modifications, to be licensed at no charge to all third parties under the terms of this General Public License (except that you may choose to grant warranty protection to some or all third parties, at your option). c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the simplest and most usual way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this General Public License. d) You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. Mere aggregation of another independent work with the Program (or its derivative) on a volume of a storage or distribution medium does not bring the other work under the scope of these terms. 3. You may copy and distribute the Program (or a portion or derivative of it, under Paragraph 2) in object code or executable form under the terms of Paragraphs 1 and 2 above provided that you also do one of the following: a) accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Paragraphs 1 and 2 above; or, b) accompany it with a written offer, valid for at least three years, to give any third party free (except for a nominal charge for the cost of distribution) a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Paragraphs 1 and 2 above; or, c) accompany it with the information you received as to where the corresponding source code may be obtained. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form alone.) Source code for a work means the preferred form of the work for making modifications to it. For an executable file, complete source code means all the source code for all modules it contains; but, as a special exception, it need not include source code for modules which are standard libraries that accompany the operating system on which the executable file runs, or for standard header files or definitions files that accompany that operating system. 4. You may not copy, modify, sublicense, distribute or transfer the Program except as expressly provided under this General Public License. Any attempt otherwise to copy, modify, sublicense, distribute or transfer the Program is void, and will automatically terminate your rights to use the Program under this License. However, parties who have received copies, or rights to use copies, from you under this General Public License will not have their licenses terminated so long as such parties remain in full compliance. 5. By copying, distributing or modifying the Program (or any work based on the Program) you indicate your acceptance of this license to do so, and all its terms and conditions. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. 7. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of the license which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the license, you may choose any version ever published by the Free Software Foundation. 8. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to humanity, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19xx name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (a program to direct compilers to make passes at assemblers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice That's all there is to it! --- The Perl Artistic License 1.0 --- This software is Copyright (c) 2025 by Graham Barr . This is free software, licensed under: The Perl Artistic License 1.0 The "Artistic License" Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder as specified below. "Copyright Holder" is whoever is named in the copyright or copyrights for the package. "You" is you, if you're thinking about copying or distributing this Package. "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as uunet.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) give non-standard executables non-standard names, and clearly document the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. You may embed this Package's interpreter within an executable of yours (by linking); this shall be construed as a mere form of aggregation, provided that the complete Standard Version of the interpreter is so embedded. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whoever generated them, and may be sold commercially, and may be aggregated with this Package. If such scripts or library files are aggregated with this Package via the so-called "undump" or "unexec" methods of producing a binary executable image, then distribution of such an image shall neither be construed as a distribution of this Package nor shall it fall under the restrictions of Paragraphs 3 and 4, provided that you do not represent such an executable image as a Standard Version of this Package. 7. C subroutines (or comparably compiled subroutines in other languages) supplied by you and linked into this Package in order to emulate subroutines and variables of the language defined by this Package shall not be considered part of this Package, but are the equivalent of input as in Paragraph 6, provided these subroutines do not change the language in any way that would cause it to fail the regression tests for the language. 8. Aggregation of this Package with a commercial distribution is always permitted provided that the use of this Package is embedded; that is, when no overt attempt is made to make this Package's interfaces visible to the end user of the commercial distribution. Such use shall not be construed as a distribution of this Package. 9. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End Changes100644001750001750 2013515044402605 14235 0ustar00erikerik000000000000Authen-SASL-2.1900 2.1900 2025-08-05 [Fixed] - CVE-2025-40918 (Insecure source of randomness), required addition of dependency on Crypt::URandom [Changed] - Modules Authen::SASL::Perl::CRAM_MD5, Authen::SASL::Perl::DIGEST_MD5 and Authen::SASL::CRAM_MD5 marked as deprecated based on the respective RFC documents; thanks to @robrwo for the suggestion and @neustradamus for the pointers to the documentation - Update module metadata to point to the new 'perl-authen-sasl' org on GitHub to which the modules moved - Use VERSION declarations in 'package' statements, since our minimum Perl version is 5.14 anyway 2.1800 2025-04-25 [Changed] - Minimum required Perl version 5.14+ (from 5.6.0); Digest::HMAC_MD5 was 5.8.1, making 5.8.1 the effective minimum - Move example code to the eg/ directory [Added] - Mechanisms XOAUTH2 and OAUTHBEARER added - Include mechanisms available on server when negotiation fails on the client - Add `_acceptable()` function to allow mechanism implementation classes to decline selection based on the callback values 2.1700 2023-08-09 [Fixed] - Version numbering (released as 2.1700, because 2.17 < 2.1401) - POD errors - Typos - Minimum Perl version 5.005 -> 5.6.0 - Kwalitee errors * Accidentally packaged MYMETA.* * 'use warnings;' added in all modules * Synchronized versions in all modules - Out of bounds substr() (RT 85294) [Added] - README - More tests [Changed] - Release switched from EUMM to D::Z [Removed] - Authen::SASL::Cyrus is no longer loaded as an implementation; Authen::SASL::XS has been the successor for more than a decade Authen-SASL 2.16 -- Tue Sep 4 11:01:18 CDT 2012 * SASL.pod: fix typo [Peter Marschall] * Perl.pm: avoid warning on "uninitialized value" [Peter Marschall] Authen-SASL 2.15 -- Wed Jun 2 13:47:41 CDT 2010 * Makes sure that user callbacks are called [Yann Kerherve] Authen-SASL 2.1401 -- Mon Mar 29 14:22:54 CDT 2010 * Add META.yml to release Authen-SASL 2.14 -- Thu Mar 11 08:21:07 CST 2010 * Documentation updates [Yann Kerherve] * Added server API description [Yann Kerherve] * Bugfixes to LOGIN, PLAIN and DIGEST_MD5 [Yann Kerherve] * Added server support for LOGIN, PLAINaand DIGEST_MD5 [Yann Kerherve] * Compatiblity with Authen::SASL::XS [Yann Kerherve] Authen-SASL 2.13 -- Thu Sep 24 17:27:47 CDT 2009 * RT#42191 Only use pass for GSSAPI credentials if it is an object of type GSSAPI::Cred * RT#675 Authorization with Authen::SASL::Perl::External * Call client_new and server_new inside eval so further plugins can be tried before failing * Prefer to use Authen::SASL::XS over Authen::SASL::Cyrus Authen-SASL 2.12 -- Mon Jun 30 21:35:21 CDT 2008 Enhancements * GSSAPI implement protocol according to RFC, but by default, remain compatible with cyrus sasl lib * DIGEST-MD5 implement channel encryption layer Authen-SASL 2.11 -- Mon Apr 21 10:23:19 CDT 2008 Enhancements * implement securesocket() in the ::Perl set of plugins Bug Fixes * fix parsing challenges from GnuSASL * update tests for DIGEST-MD5 * New test from Phil Pennock for testing final server response Authen-SASL 2.10 -- Sat Mar 25 13:11:47 CST 2006 Enhancements * Added Authen::SASL::Perl::GSSAPI * Added error method to Authen::SASL to obtain error from last connection Bug Fixes * Authen::SASL::Perl::DIGEST_MD5 - Fixed response to server to pass digest-uri - Correct un-escaping behaviour when reading the challenge, - check for required fields (according to the RFC), - allow for qop not to be sent from the server (according to the RFC), - add a callback for the realm. Authen-SASL 2.09 -- Tue Apr 26 06:55:10 CDT 2005 Enhancements * authname support in Authen::SASL::Perl::DIGEST_MD5 * flexible plugin selection in Authen::SASL using import() i.e. use Authen::SASL qw(Authen::SASL::Cyrus); * new documentation for - Authen::SASL::Perl::ANONYMOUS - Authen::SASL::Perl::CRAM_MD5 - Authen::SASL::Perl::EXTERNAL - Authen::SASL::Perl::LOGIN - Authen::SASL::Perl::PLAIN - Authen::SASL::Perl * updates in the tests Authen-SASL 2.08 -- Tue May 25 11:24:21 BST 2004 Bug Fixes * Fix the handling of qop in Digest-MD5 Authen-SASL 2.07 -- Sat Apr 10 09:06:21 BST 2004 Bug Fixes * Fixed test bug if Digest::HMAC_MD5 was not installed * Fixed order of values sent in the PLAIN mechanism Enhancements * Added support in the framework for server-side plugins 2003-11-01 18:48 Graham Barr * lib/Authen/SASL.pm: Release 2.06 2003-10-21 19:59 Graham Barr * MANIFEST, lib/Authen/SASL/Perl.pm, lib/Authen/SASL/Perl/ANONYMOUS.pm, lib/Authen/SASL/Perl/CRAM_MD5.pm, lib/Authen/SASL/Perl/DIGEST_MD5.pm, lib/Authen/SASL/Perl/EXTERNAL.pm, lib/Authen/SASL/Perl/LOGIN.pm, lib/Authen/SASL/Perl/PLAIN.pm, t/order.t: Add ordering so we always pich the best of the available methods instead of just the first 2003-10-17 22:12 Graham Barr * lib/Authen/SASL.pm: Release 2.05 2003-10-17 22:06 Graham Barr * MANIFEST, Makefile.PL: use Module::Install to generate Makefile and add SIGNATURE and META.yml 2003-10-17 21:19 Graham Barr * lib/Authen/SASL/Perl/DIGEST_MD5.pm: Fix typo 2003-10-17 21:17 Graham Barr * lib/Authen/SASL/: Perl.pm, Perl/DIGEST_MD5.pm: Don't call die in DIGEST_MD5, but call set_error and return an empty list 2003-10-17 21:16 Graham Barr * lib/Authen/SASL.pod: Update docs to reflect that client_start and client_step return an emtpy list on error 2003-05-19 22:41 Graham Barr * lib/Authen/SASL.pm: Release 2.04 2003-05-19 22:40 Graham Barr * t/digest_md5.t: Avoid used only once warning 2003-05-19 17:06 Graham Barr * MANIFEST, lib/Authen/SASL/Perl/DIGEST_MD5.pm, t/digest_md5.t: Add DIGEST-MD5 mechanism 2003-05-19 16:42 Graham Barr * MANIFEST, t/login.t: Add test for login mechanism 2003-01-21 19:15 Graham Barr * lib/Authen/SASL.pm: Release 2.03 2003-01-21 12:22 Graham Barr * lib/Authen/SASL/Perl/LOGIN.pm: Fix LOGIN mechanism to respond with the username when prompted 2002-05-28 15:22 Graham Barr * lib/Authen/SASL.pm: Release 2.02 2002-05-28 14:36 Graham Barr * MANIFEST, lib/Authen/SASL/Perl/LOGIN.pm: Add LOGIN mechanism commonly used by SMTP 2002-03-31 15:39 Graham Barr * lib/Authen/SASL.pm: Release 2.01 2002-03-22 10:13 Graham Barr * t/cram_md5.t: Skip cram_md5 test if Digest::HMAC_MD5 is not installed 2002-02-18 16:56 Graham Barr * lib/Authen/SASL/Perl.pm: Add securesocket to the ::Perl base class. 2002-01-28 19:52 Graham Barr * MANIFEST, lib/Authen/SASL.pm, t/anon.t, t/callback.t, t/cram_md5.t, t/external.t, t/plain.t: Add some tests 2002-01-24 15:21 Graham Barr * lib/Authen/SASL/Perl.pm: Allow callback to be called on the connection object 2002-01-24 12:04 Graham Barr * MANIFEST, Makefile.PL, api.txt, compat_pl, example_pl, lib/Authen/SASL.pm, lib/Authen/SASL.pod, lib/Authen/SASL/CRAM_MD5.pm, lib/Authen/SASL/EXTERNAL.pm, lib/Authen/SASL/Perl.pm, lib/Authen/SASL/Perl/ANONYMOUS.pm, lib/Authen/SASL/Perl/CRAM_MD5.pm, lib/Authen/SASL/Perl/EXTERNAL.pm, lib/Authen/SASL/Perl/PLAIN.pm: Initial revision 2002-01-24 12:04 Graham Barr * MANIFEST, Makefile.PL, api.txt, compat_pl, example_pl, lib/Authen/SASL.pm, lib/Authen/SASL.pod, lib/Authen/SASL/CRAM_MD5.pm, lib/Authen/SASL/EXTERNAL.pm, lib/Authen/SASL/Perl.pm, lib/Authen/SASL/Perl/ANONYMOUS.pm, lib/Authen/SASL/Perl/CRAM_MD5.pm, lib/Authen/SASL/Perl/EXTERNAL.pm, lib/Authen/SASL/Perl/PLAIN.pm: import api.txt100644001750001750 457315044402605 14244 0ustar00erikerik000000000000Authen-SASL-2.1900 Client API ---------- Basically the Authen::SASL module gathers some info. When ->client_new is called the plugin is called to create a $conn object. At that point it should query the Authen::SASL object for mechanisms and callbacks Properties are then set on the $conn object by calling $conn->property Then client_start is called Then we call client_step with a challenge string to get a response string. need_step can be called to check that this step is actually necessary for the selected mechanism. Quite simple really I think. So the plugin just needs to support client_new client_start client_step need_step # returns true if client_step needs to be called property # set/get for properties mechanism # returns the name of the chosen mechanism service # the service name passed to client_new host # the hostname passed to client_new is_success # returns true if authentication suceeded _order # returns rank number for order of preference _acceptable # returns true if all required properties are supplied Server API ---------- The server API is symetric to the client's one. server_new is called to create a connection object. Then server_start is called, and if relevant the first data from the client is passed to it as argument. Then we call server_step with all the response from the clients, which returns challenges. need_step also determines if the current mechanism requires another step. So the plugin just needs to support server_new server_start server_step need_step # returns true if client_step needs to be called property # set/get for properties mechanism # returns the name of the chosen mechanism service # the service name passed to client_new host # the hostname passed to client_new is_success # returns true if authentication suceeded Callbacks --------- properties and callbacks are passed by name, so you will need to convert them to numbers. There are three types of call back user => 'fred' When the user callback is called, it will just return the string 'fred' user => \&subname When the user callback is called, &subname will be called and it will be passed the $conn object as the first argument. user => [ \&subname, 1, 2, 3] When the user callback is called, &subname will be called. It will be passed the $conn object, followed by all other values in the array META.yml100644001750001750 532315044402605 14175 0ustar00erikerik000000000000Authen-SASL-2.1900--- abstract: 'SASL Authentication framework' author: - 'Graham Barr ' - 'Erik Huelsmann ' build_requires: Pod::Coverage::TrustPod: '0' Test::More: '0' Test::Pod: '0' Test::Pod::Coverage: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 0 generated_by: 'Dist::Zilla version 6.033, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Authen-SASL provides: Authen::SASL: file: lib/Authen/SASL.pm version: '2.1900' Authen::SASL::CRAM_MD5: file: lib/Authen/SASL/CRAM_MD5.pm version: '2.1900' x_deprecated: 1 Authen::SASL::EXTERNAL: file: lib/Authen/SASL/EXTERNAL.pm version: '2.1900' Authen::SASL::Perl: file: lib/Authen/SASL/Perl.pm version: '2.1900' Authen::SASL::Perl::ANONYMOUS: file: lib/Authen/SASL/Perl/ANONYMOUS.pm version: '2.1900' Authen::SASL::Perl::CRAM_MD5: file: lib/Authen/SASL/Perl/CRAM_MD5.pm version: '2.1900' x_deprecated: 1 Authen::SASL::Perl::DIGEST_MD5: file: lib/Authen/SASL/Perl/DIGEST_MD5.pm version: '2.1900' x_deprecated: 1 Authen::SASL::Perl::EXTERNAL: file: lib/Authen/SASL/Perl/EXTERNAL.pm version: '2.1900' Authen::SASL::Perl::GSSAPI: file: lib/Authen/SASL/Perl/GSSAPI.pm version: '2.1900' Authen::SASL::Perl::LOGIN: file: lib/Authen/SASL/Perl/LOGIN.pm version: '2.1900' Authen::SASL::Perl::OAUTHBEARER: file: lib/Authen/SASL/Perl/OAUTHBEARER.pm version: '2.1900' Authen::SASL::Perl::PLAIN: file: lib/Authen/SASL/Perl/PLAIN.pm version: '2.1900' Authen::SASL::Perl::XOAUTH2: file: lib/Authen/SASL/Perl/XOAUTH2.pm version: '2.1900' recommends: GSSAPI: '0' requires: Crypt::URandom: '0' Digest::HMAC_MD5: '0' perl: v5.14.0 resources: bugtracker: https://github.com/perl-authen-sasl/perl-authen-sasl/issues homepage: https://github.com/perl-authen-sasl/perl-authen-sasl/ repository: git://github.com/perl-authen-sasl/perl-authen-sasl.git version: '2.1900' x_contributors: - 'Aditya Garg ' - 'Chris Ridd ' - 'David Steinbrunner ' - 'Graham Ollis ' - 'Norbert Klasen ' - 'Paul Kranenburg ' - 'Pete Houston ' - 'Peter Marschall ' - 'Robert Rothenberg ' - 'Steven Lee ' - 'Yann Kerherve ' - 'openstrike ' x_generated_by_perl: v5.38.2 x_serialization_backend: 'YAML::Tiny version 1.76' x_spdx_expression: 'Artistic-1.0-Perl OR GPL-1.0-or-later' MANIFEST100644001750001750 163215044402605 14054 0ustar00erikerik000000000000Authen-SASL-2.1900# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.033. Changes LICENSE MANIFEST META.json META.yml Makefile.PL README api.txt dist.ini eg/compat.pl eg/example.pl lib/Authen/SASL.pm lib/Authen/SASL.pod lib/Authen/SASL/CRAM_MD5.pm lib/Authen/SASL/EXTERNAL.pm lib/Authen/SASL/Perl.pm lib/Authen/SASL/Perl.pod lib/Authen/SASL/Perl/ANONYMOUS.pm lib/Authen/SASL/Perl/CRAM_MD5.pm lib/Authen/SASL/Perl/DIGEST_MD5.pm lib/Authen/SASL/Perl/EXTERNAL.pm lib/Authen/SASL/Perl/GSSAPI.pm lib/Authen/SASL/Perl/LOGIN.pm lib/Authen/SASL/Perl/OAUTHBEARER.pm lib/Authen/SASL/Perl/PLAIN.pm lib/Authen/SASL/Perl/XOAUTH2.pm t/anon.t t/author-pod-syntax.t t/callback.t t/compat.t t/cram_md5.t t/digest_md5.t t/digest_md5_verified.t t/external.t t/lib/common.pl t/login.t t/negotiations/digest_md5.t t/negotiations/login.t t/negotiations/plain.t t/order.t t/plain.t t/server/digest_md5.t t/server/login.t t/server/plain.t dist.ini100644001750001750 235015044402605 14365 0ustar00erikerik000000000000Authen-SASL-2.1900name = Authen-SASL abstract = SASL Authentication framework version = 2.1900 author = Graham Barr author = Erik Huelsmann copyright_holder = Graham Barr main_module = lib/Authen/SASL.pm license = Perl_5 [MetaResources] homepage = https://github.com/perl-authen-sasl/perl-authen-sasl/ bugtracker.web = https://github.com/perl-authen-sasl/perl-authen-sasl/issues repository.url = git://github.com/perl-authen-sasl/perl-authen-sasl.git repository.web = https://github.com/perl-authen-sasl/perl-authen-sasl/ repository.type = git [@Filter] -bundle = @Basic -remove = GatherDir -remove = Readme [Deprecated] module = Authen::SASL::Perl::DIGEST_MD5 module = Authen::SASL::Perl::CRAM_MD5 module = Authen::SASL::CRAM_MD5 [Git::GatherDir] [MetaJSON] [MetaProvides::Package] [ContributorsFromGit] [Prereqs] perl = 5.14.0 Digest::HMAC_MD5 = 0 Crypt::URandom = 0 [Prereqs / RuntimeRecommends] GSSAPI = 0 [Prereqs / TestRequires] Test::More = 0 Test::Pod = 0 Test::Pod::Coverage = 0 Pod::Coverage::TrustPod = 0 [Prereqs / DevelopRequires] Pod::Weaver::Section::ReplaceVersion = 0 [ExtraTests] ;[PodCoverageTests] [PodSyntaxTests] [PodVersion] [PkgVersion] use_package = 1 t000755001750001750 015044402605 13024 5ustar00erikerik000000000000Authen-SASL-2.1900anon.t100644001750001750 107015044402605 14302 0ustar00erikerik000000000000Authen-SASL-2.1900/t#!perl use Test::More tests => 5; use Authen::SASL qw(Perl); my $sasl = Authen::SASL->new( mechanism => 'ANONYMOUS', callback => { user => 'gbarr', pass => 'fred', authname => 'none' }, ); ok($sasl, 'new'); is($sasl->mechanism, 'ANONYMOUS', 'mechanism is ANONYMOUS'); my $conn = $sasl->client_new("ldap","localhost"); is($conn->mechanism, 'ANONYMOUS', 'connection mechanism is ANONYMOUS'); my $initial = $conn->client_start; ok($initial eq 'none', 'client_start'); my $step = $conn->client_step("xyz"); is($step, 'none', 'client_step'); login.t100644001750001750 113715044402605 14463 0ustar00erikerik000000000000Authen-SASL-2.1900/t#!perl use Test::More tests => 6; use Authen::SASL qw(Perl); my $sasl = Authen::SASL->new( mechanism => 'LOGIN', callback => { user => 'gbarr', pass => 'fred', authname => 'none' }, ); ok($sasl, 'new'); is($sasl->mechanism, 'LOGIN', 'sasl mechanism'); my $conn = $sasl->client_new("ldap","localhost"); is($conn->mechanism, 'LOGIN', 'conn mechanism'); is($conn->client_start, '', 'client_start'); is($conn->client_step("username"), 'gbarr', 'client_step username'); is($conn->client_step("password"), 'fred', 'client_step password'); ## XXX TODO check for success and extra steps order.t100644001750001750 202215044402605 14460 0ustar00erikerik000000000000Authen-SASL-2.1900/t#!perl use Test::More tests => 75; use Authen::SASL qw(Perl); my %order = qw( ANONYMOUS 0 LOGIN 1 PLAIN 1 CRAM-MD5 2 EXTERNAL 2 DIGEST-MD5 3 ); my $skip3 = !eval { require Digest::MD5 and $Digest::MD5::VERSION || $Digest::MD5::VERSION }; foreach my $level (reverse 0..3) { my @mech = grep { $order{$_} <= $level } keys %order; foreach my $n (1..@mech) { push @mech, shift @mech; # rotate my $mech = join(" ",@mech); print "# $level $mech\n"; if ($level == 3 and $skip3) { SKIP: { skip "requires Digest::MD5", 5; } next; } my $sasl = Authen::SASL->new( mechanism => $mech, callback => { user => 'gbarr', pass => 'fred', authname => 'none' }, ); ok($sasl, "new"); is($sasl->mechanism, $mech, "sasl mechanism"); my $conn = $sasl->client_new("ldap","localhost"); ok($conn, 'client_new'); my $chosen = $conn->mechanism; ok($chosen, 'conn mechanism ' . ($chosen || '?')); is($order{$chosen}, $level, 'mechanism level'); } } plain.t100644001750001750 155415044402605 14461 0ustar00erikerik000000000000Authen-SASL-2.1900/t#!perl use Test::More tests => 14; use Authen::SASL qw(Perl); my $sasl = Authen::SASL->new( mechanism => 'PLAIN', callback => { user => 'gbarr', pass => 'fred', authname => 'none' }, ); ok($sasl, 'new'); is($sasl->mechanism, 'PLAIN', 'sasl mechanism'); my $conn = $sasl->client_new("ldap","localhost"); is($conn->mechanism, 'PLAIN', 'conn mechanism'); ok $conn->need_step, "we need to *start* at the minimum"; ok !$conn->is_success, "no success yet"; ok !$conn->error, "and no error"; is($conn->client_start, "none\0gbarr\0fred", 'client_start'); ok !$conn->need_step, "we're done, plain is kinda quick"; ok $conn->is_success, "success!"; ok !$conn->error, "and no error"; is($conn->client_step("xyz"), undef, 'client_step'); ok !$conn->need_step, "we're done already"; ok $conn->is_success, "sucess already"; ok !$conn->error, "and no error"; META.json100644001750001750 1011115044402605 14354 0ustar00erikerik000000000000Authen-SASL-2.1900{ "abstract" : "SASL Authentication framework", "author" : [ "Graham Barr ", "Erik Huelsmann " ], "dynamic_config" : 0, "generated_by" : "Dist::Zilla version 6.033, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Authen-SASL", "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "develop" : { "requires" : { "Pod::Weaver::Section::ReplaceVersion" : "0", "Test::Pod" : "1.41" } }, "runtime" : { "recommends" : { "GSSAPI" : "0" }, "requires" : { "Crypt::URandom" : "0", "Digest::HMAC_MD5" : "0", "perl" : "v5.14.0" } }, "test" : { "requires" : { "Pod::Coverage::TrustPod" : "0", "Test::More" : "0", "Test::Pod" : "0", "Test::Pod::Coverage" : "0" } } }, "provides" : { "Authen::SASL" : { "file" : "lib/Authen/SASL.pm", "version" : "2.1900" }, "Authen::SASL::CRAM_MD5" : { "file" : "lib/Authen/SASL/CRAM_MD5.pm", "version" : "2.1900", "x_deprecated" : 1 }, "Authen::SASL::EXTERNAL" : { "file" : "lib/Authen/SASL/EXTERNAL.pm", "version" : "2.1900" }, "Authen::SASL::Perl" : { "file" : "lib/Authen/SASL/Perl.pm", "version" : "2.1900" }, "Authen::SASL::Perl::ANONYMOUS" : { "file" : "lib/Authen/SASL/Perl/ANONYMOUS.pm", "version" : "2.1900" }, "Authen::SASL::Perl::CRAM_MD5" : { "file" : "lib/Authen/SASL/Perl/CRAM_MD5.pm", "version" : "2.1900", "x_deprecated" : 1 }, "Authen::SASL::Perl::DIGEST_MD5" : { "file" : "lib/Authen/SASL/Perl/DIGEST_MD5.pm", "version" : "2.1900", "x_deprecated" : 1 }, "Authen::SASL::Perl::EXTERNAL" : { "file" : "lib/Authen/SASL/Perl/EXTERNAL.pm", "version" : "2.1900" }, "Authen::SASL::Perl::GSSAPI" : { "file" : "lib/Authen/SASL/Perl/GSSAPI.pm", "version" : "2.1900" }, "Authen::SASL::Perl::LOGIN" : { "file" : "lib/Authen/SASL/Perl/LOGIN.pm", "version" : "2.1900" }, "Authen::SASL::Perl::OAUTHBEARER" : { "file" : "lib/Authen/SASL/Perl/OAUTHBEARER.pm", "version" : "2.1900" }, "Authen::SASL::Perl::PLAIN" : { "file" : "lib/Authen/SASL/Perl/PLAIN.pm", "version" : "2.1900" }, "Authen::SASL::Perl::XOAUTH2" : { "file" : "lib/Authen/SASL/Perl/XOAUTH2.pm", "version" : "2.1900" } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/perl-authen-sasl/perl-authen-sasl/issues" }, "homepage" : "https://github.com/perl-authen-sasl/perl-authen-sasl/", "repository" : { "type" : "git", "url" : "git://github.com/perl-authen-sasl/perl-authen-sasl.git", "web" : "https://github.com/perl-authen-sasl/perl-authen-sasl/" } }, "version" : "2.1900", "x_contributors" : [ "Aditya Garg ", "Chris Ridd ", "David Steinbrunner ", "Graham Ollis ", "Norbert Klasen ", "Paul Kranenburg ", "Pete Houston ", "Peter Marschall ", "Robert Rothenberg ", "Steven Lee ", "Yann Kerherve ", "openstrike " ], "x_generated_by_perl" : "v5.38.2", "x_serialization_backend" : "Cpanel::JSON::XS version 4.39", "x_spdx_expression" : "Artistic-1.0-Perl OR GPL-1.0-or-later" } compat.t100644001750001750 230015044402605 14627 0ustar00erikerik000000000000Authen-SASL-2.1900/t#!perl # Test of the methods marked "Compat" in Authen::SASL # Heavily based on the compat_pl script at the root level # (which this essentially replaces) use strict; use warnings; use Test::More tests => 8; use Authen::SASL; my $sasl = Authen::SASL->new('CRAM-MD5', password => 'fred'); $sasl->user('foo'); is ($sasl->user('gbarr'), 'foo', 'user method returns previous value'); is ($sasl->user, 'gbarr', 'user method with no args returns value'); my $initial = $sasl->initial; is ($initial, '', 'initial method returns empty string'); my $mech = $sasl->name; is ($mech, 'CRAM-MD5', 'mech method returns mechanism'); #print "$mech;", unpack("H*",$initial),";\n"; #print unpack "H*", $sasl->challenge('xyz'); is ((unpack "H*", $sasl->challenge('xyz')), '6762617272203336633933316665343766336665396337616462663831306233633763346164', "$mech challenge matches"); $sasl = Authen::SASL->new(mech => 'CRAM-MD5', password => 'fred'); $mech = $sasl->name; is ($mech, 'CRAM-MD5', 'constructor allows "mech" as first key'); $sasl = Authen::SASL->new(foo => 'CRAM-MD5', password => 'fred'); $mech = $sasl->name; is ($mech, undef, 'constructor with no mechanism at all'); is ($sasl->error, undef, 'no errors'); Makefile.PL100644001750001750 247315044402605 14701 0ustar00erikerik000000000000Authen-SASL-2.1900# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v6.033. use strict; use warnings; use 5.014000; use ExtUtils::MakeMaker; my %WriteMakefileArgs = ( "ABSTRACT" => "SASL Authentication framework", "AUTHOR" => "Graham Barr , Erik Huelsmann ", "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => 0 }, "DISTNAME" => "Authen-SASL", "LICENSE" => "perl", "MIN_PERL_VERSION" => "5.014000", "NAME" => "Authen::SASL", "PREREQ_PM" => { "Crypt::URandom" => 0, "Digest::HMAC_MD5" => 0 }, "TEST_REQUIRES" => { "Pod::Coverage::TrustPod" => 0, "Test::More" => 0, "Test::Pod" => 0, "Test::Pod::Coverage" => 0 }, "VERSION" => "2.1900", "test" => { "TESTS" => "t/*.t t/negotiations/*.t t/server/*.t" } ); my %FallbackPrereqs = ( "Crypt::URandom" => 0, "Digest::HMAC_MD5" => 0, "Pod::Coverage::TrustPod" => 0, "Test::More" => 0, "Test::Pod" => 0, "Test::Pod::Coverage" => 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); eg000755001750001750 015044402605 13154 5ustar00erikerik000000000000Authen-SASL-2.1900compat.pl100755001750001750 55715044402605 15126 0ustar00erikerik000000000000Authen-SASL-2.1900/eg#!/usr/bin/env perl # short script to check compatability with previous Authen::SASL library use lib 'lib'; use Authen::SASL; my $sasl = Authen::SASL->new('CRAM-MD5', password => 'fred'); $sasl->user('gbarr'); $initial = $sasl->initial; $mech = $sasl->name; print "$mech;", unpack("H*",$initial),";\n"; print unpack "H*", $sasl->challenge('xyz'); print "\n"; callback.t100644001750001750 122615044402605 15106 0ustar00erikerik000000000000Authen-SASL-2.1900/t#!perl use Test::More tests => 7; use Authen::SASL qw(Perl); my $sasl = Authen::SASL->new( mechanism => 'PLAIN', callback => { user => 'gbarr', pass => \&cb_pass, authname => [ \&cb_authname, 1 ], }, ); ok($sasl, 'new'); is($sasl->mechanism, 'PLAIN', 'sasl mechanism'); my $conn = $sasl->client_new("ldap","localhost"); is($conn->mechanism, 'PLAIN', 'conn mechanism'); my $test = 4; is($conn->client_start, "none\0gbarr\0fred", "client_start"); is($conn->client_step("xyz"), undef, "client_step"); sub cb_pass { ok(1,'pass callback'); 'fred'; } sub cb_authname { ok((@_ == 2 and $_[1] == 1), 'authname callback'); 'none'; } cram_md5.t100644001750001750 167315044402605 15047 0ustar00erikerik000000000000Authen-SASL-2.1900/t#!perl BEGIN { eval { require Digest::HMAC_MD5 } } use Test::More ($Digest::HMAC_MD5::VERSION ? (tests => 6) : (skip_all => 'Need Digest::HMAC_MD5')); use Authen::SASL qw(Perl); my $sasl = Authen::SASL->new( mechanism => 'CRAM-MD5', callback => { user => 'gbarr', pass => 'fred', authname => 'none' }, ); ok($sasl, 'new'); is($sasl->mechanism, 'CRAM-MD5', 'sasl mechanism'); my $conn = $sasl->client_new("ldap","localhost", "noplaintext noanonymous"); is($conn->mechanism, 'CRAM-MD5', 'conn mechanism'); is($conn->client_start, '', 'client_start'); is($conn->client_step("xyz"), 'gbarr 36c931fe47f3fe9c7adbf810b3c7c4ad', 'client_step'); $sasl = Authen::SASL->new( mechanism => 'CRAM-MD5', callback => { pass => 'fred', authname => 'none' }, ); $conn = $sasl->client_new("ldap","localhost", "noplaintext noanonymous"); is($conn->client_step("xyz"), ' 36c931fe47f3fe9c7adbf810b3c7c4ad', 'client_step no user'); external.t100644001750001750 123615044402605 15175 0ustar00erikerik000000000000Authen-SASL-2.1900/t#!perl use Test::More tests => 6; use Authen::SASL qw(Perl); my $sasl = Authen::SASL->new( mechanism => 'EXTERNAL', callback => { user => 'gbarr', pass => 'fred', authname => 'none' }, ); ok($sasl, 'new'); is($sasl->mechanism, 'EXTERNAL', 'sasl mechanism'); my $conn = $sasl->client_new("ldap","localhost", "noplaintext"); is($conn->mechanism, 'EXTERNAL', 'conn mechanism'); is($conn->client_start, 'gbarr', 'client_start'); is($conn->client_step("xyz"), undef, 'client_step'); $sasl = Authen::SASL->new(mechanism => 'EXTERNAL'); $conn = $sasl->client_new("ldap","localhost", "noplaintext"); is ($conn->client_start, '', 'no user callback'); example.pl100755001750001750 157315044402605 15315 0ustar00erikerik000000000000Authen-SASL-2.1900/eg#!/usr/bin/env perl # short example script use lib 'lib'; use Authen::SASL; # This part is in the user script my $sasl = Authen::SASL->new( mechanism => 'PLAIN CRAM-MD5 EXTERNAL ANONYMOUS', callback => { user => 'gbarr', pass => 'fred', authname => 'none' }, ); # $sasl is then passed to a library (eg Net::LDAP) # which will then do my $conn = $sasl->client_new("ldap","localhost", "noplaintext noanonymous"); # The library would also set properties on the connection #$conn->property( # iplocal => $socket->sockname, # ipremote => $socket->peername, #); # It would then start things off and send this info to the server my $initial = $conn->client_start; my $mech = $conn ->mechanism; print "$mech;", unpack("H*",$initial),";\n"; # When the server want more information, the library would call print unpack "H*", $conn->client_step("xyz"); print "\n"; digest_md5.t100644001750001750 544515044402605 15405 0ustar00erikerik000000000000Authen-SASL-2.1900/t#!perl BEGIN { require Test::More; eval { require Digest::MD5 } or Test::More->import(skip_all => 'Need Digest::MD5'); eval { require Digest::HMAC_MD5 } or Test::More->import(skip_all => 'Need Digest::HMAC_MD5'); } use Test::More (tests => 27); use Authen::SASL qw(Perl); my $authname; my $sasl = Authen::SASL->new( mechanism => 'DIGEST-MD5', callback => { user => 'gbarr', pass => 'fred', authname => sub { $authname }, }, ); ok($sasl,'new'); is($sasl->mechanism, 'DIGEST-MD5', 'sasl mechanism'); my $conn = $sasl->client_new("ldap","localhost", "noplaintext noanonymous"); is($conn->mechanism, 'DIGEST-MD5', 'conn mechanism'); is($conn->client_start, '', 'client_start'); ok $conn->need_step, "we need extra steps"; ok !$conn->is_success, "success will be later if we are good boys"; ok !$conn->error, "so far so good"; my $sparams = 'realm="elwood.innosoft.com",nonce="OA6MG9tEQGm2hh",qop="auth,auth-inf",algorithm=md5-sess,charset=utf-8'; # override for testing as by default it uses $$, time and rand $Authen::SASL::Perl::DIGEST_MD5::CNONCE = "foobar"; $Authen::SASL::Perl::DIGEST_MD5::CNONCE = "foobar"; # avoid used only once warning my $initial = $conn->client_step($sparams); ok $conn->need_step, "we need extra steps"; ok !$conn->is_success, "success will be later if we are good boys"; ok !$conn->error, "so far so good"; my @expect = qw( charset=utf-8 cnonce="3858f62230ac3c915f300c664312c63f" digest-uri="ldap/localhost" nc=00000001 nonce="OA6MG9tEQGm2hh" qop=auth realm="elwood.innosoft.com" response=9c81619e12f61fb2eed6bc8ed504ad28 username="gbarr" ); is( $initial, join(",", @expect), 'client_step [1]' ); my $response='rspauth=d1273170c120bae49cea49de9b4c5bdc'; $initial = $conn->client_step($response); ok !$conn->need_step, "we're done"; ok $conn->is_success, "success !"; ok !$conn->error, "we did a good job"; is( $initial, '', 'client_step [2]' ); # .. .and now everything with an authname is($conn->client_start, '', 'client_start'); ok $conn->need_step, "we need extra steps"; ok !$conn->is_success, "success will be later if we are good boys"; ok !$conn->error, "so far so good"; $authname = 'meme'; $initial = $conn->client_step($sparams); ok $conn->need_step, "we need extra steps"; ok !$conn->is_success, "success will be later if we are good boys"; ok !$conn->error, "so far so good"; $expect[3] = 'nc=00000002'; $expect[7] = 'response=8d8afc5ff9cf3add40e50a5eaabb9aac'; is( $initial, join(",", 'authzid="meme"', @expect), 'client_step + authname [1]' ); $response='rspauth=dcb2b36dcd0750d3a7d0482fe1872769'; $initial = $conn->client_step($response); ok !$conn->need_step, "we're done"; ok $conn->is_success, "success !"; ok !$conn->error, "we did a good job"; is( $initial, '', 'client_step + authname [2]' ) or diag $conn->error; lib000755001750001750 015044402605 13572 5ustar00erikerik000000000000Authen-SASL-2.1900/tcommon.pl100644001750001750 164215044402605 15562 0ustar00erikerik000000000000Authen-SASL-2.1900/t/libuse strict; use warnings; use Authen::SASL ('Perl'); sub negotiate { my ($c, $s, $do) = @_; my $client_sasl = Authen::SASL->new( %{ $c->{sasl} } ); my $server_sasl = Authen::SASL->new( %{ $s->{sasl} } ); my $client = $client_sasl->client_new(@$c{qw/service host security/}); my $server = $server_sasl->server_new(@$s{qw/service host/}); my $start = $client->client_start(); my $challenge; my $next_cb = sub { $challenge = shift }; $server->server_start($start, $next_cb); my $response; ## note: this wouldn't work in a real async environment while ($client->need_step || $server->need_step) { $response = $client->client_step($challenge) if $client->need_step; last if $client->error; $server->server_step($response, $next_cb) if $server->need_step; last if $server->error; } $do->($client, $server); } 1; server000755001750001750 015044402605 14332 5ustar00erikerik000000000000Authen-SASL-2.1900/tlogin.t100644001750001750 412415044402605 15770 0ustar00erikerik000000000000Authen-SASL-2.1900/t/server#!perl use strict; use warnings; use Test::More tests => 32; use Authen::SASL qw(Perl); use_ok('Authen::SASL::Perl::LOGIN'); my %params = ( mechanism => 'LOGIN', callback => { getsecret => sub { use Carp; Carp::confess("x") unless $_[2]; $_[2]->('secret') }, }, ); ok(my $ssasl = Authen::SASL->new( %params ), "new"); is($ssasl->mechanism, 'LOGIN', 'sasl mechanism'); my $server = $ssasl->server_new("xmpp","localhost"); is($server->mechanism, 'LOGIN', 'server mechanism'); is_failure(); is_failure("", ""); is_failure("xxx", "yyy", "zzz"); is_failure("a", "a", "a"); my $response; my $cb = sub { $response = shift }; $server->server_start("", $cb), is $response, "Username:"; $server->server_step("user", $cb); is $response, "Password:"; $server->server_step("secret", $cb); ok !$server->error, "no error" or diag $server->error; ok $server->is_success, "success finally"; sub is_failure { my $creds = shift; my @steps = @_; ## wouldn't really work in an async environemnt my $cb; $server->server_start("", sub { $cb = 1 }); ok $cb, "callback called"; for (@steps) { $cb = 0; $server->server_step($_, sub { $cb = 1 }); ok $cb, "callback called"; } ok !$server->is_success, "failure"; ok ($server->need_step or $server->error), "no success means that"; } ## testing checkpass callback, which takes precedence ## over getsecret when specified %params = ( mechanism => 'LOGIN', callback => { getsecret => "incorrect", checkpass => sub { my $self = shift; my ($args, $cb) = @_; is $args->{user}, "foo", "username correct"; is $args->{pass}, "bar", "correct password"; $cb->(1); return; } }, ); ok($ssasl = Authen::SASL->new( %params ), "new"); $server = $ssasl->server_new("ldap","localhost"); undef $cb; $server->server_start("", sub { $cb = 1 }); ok $cb, "callback called"; $cb = 0; $server->server_step("foo", sub { $cb = 1 }); ok $cb, "callback called"; $cb = 0; $server->server_step("bar", sub { $cb = 1 }); ok $cb, "callback called"; ok $server->is_success, "success"; plain.t100644001750001750 542515044402605 15770 0ustar00erikerik000000000000Authen-SASL-2.1900/t/server#!perl use strict; use warnings; use Test::More tests => 67; use Authen::SASL qw(Perl); use_ok('Authen::SASL::Perl::PLAIN'); my %creds = ( default => { yann => "maelys", YANN => "MAELYS", }, none => { yann => "maelys", YANN => "MAELYS", }, ); my %params = ( mechanism => 'PLAIN', callback => { getsecret => sub { my $self = shift; my ($args, $cb) = @_; $cb->($creds{$args->{authname} || "default"}{$args->{user} || ""}); }, checkpass => sub { my $self = shift; my ($args, $cb) = @_; $args ||= {}; my $username = $args->{user}; my $password = $args->{pass}; my $authzid = $args->{authname}; unless ($username) { $cb->(0); return; } my $expected = $creds{$authzid || "default"}{$username}; if ($expected && $expected eq ($password || "")) { $cb->(1); } else { $cb->(0); } return; }, }, ); ok(my $ssasl = Authen::SASL->new( %params ), "new"); is($ssasl->mechanism, 'PLAIN', 'sasl mechanism'); my $server = $ssasl->server_new("ldap","localhost"); is($server->mechanism, 'PLAIN', 'server mechanism'); for my $authname ('', 'none') { is_failure(""); is_failure("xxx"); is_failure("\0\0\0\0\0\0\0"); is_failure("\0\0\0\0\0\0\0$authname\0yann\0maelys"); is_failure("yann\0maelys\0$authname", "wrong order"); is_failure("$authname\0YANN\0maelys", "case matters"); is_failure("$authname\0yann\n\0maelys", "extra stuff"); is_failure("$authname\0yann\0\0maelys", "double null"); is_failure("$authname\0yann\0maelys\0trailing", "trailing"); my $cb; $server->server_start("$authname\0yann\0maelys", sub { $cb = 1 }); ok $cb, "callback called"; ok $server->is_success, "success finally"; } ## testing checkpass callback, which takes precedence ## over getsecret when specified %params = ( mechanism => 'PLAIN', callback => { getsecret => sub { $_[2]->("incorrect") }, checkpass => sub { my $self = shift; my ($args, $cb) = @_; is $args->{user}, "yyy", "username correct"; is $args->{pass}, "zzz", "correct password"; is $args->{authname}, "xxx", "correct realm"; $cb->(1); return; } }, ); ok($ssasl = Authen::SASL->new( %params ), "new"); $server = $ssasl->server_new("ldap","localhost"); $server->server_start("xxx\0yyy\0zzz"); ok $server->is_success, "success"; sub is_failure { my $creds = shift; my $msg = shift; my $cb; $server->server_start($creds, sub { $cb = 1 }); ok $cb, 'callback called'; ok !$server->is_success, $msg || "failure"; my $error = $server->error || ""; like $error, qr/match/i, "failure"; } Authen000755001750001750 015044402605 14553 5ustar00erikerik000000000000Authen-SASL-2.1900/libSASL.pm100644001750001750 525415044402605 16021 0ustar00erikerik000000000000Authen-SASL-2.1900/lib/Authen# Copyright (c) 2004-2006 Graham Barr . All rights reserved. # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. package Authen::SASL 2.1900; use strict; use warnings; use vars qw(@Plugins); use Carp; @Plugins = qw( Authen::SASL::XS Authen::SASL::Perl ); sub import { shift; return unless @_; local $SIG{__DIE__}; @Plugins = grep { /^[:\w]+$/ and eval "require $_" } map { /::/ ? $_ : "Authen::SASL::$_" } @_ or croak "no valid Authen::SASL plugins found"; } sub new { my $pkg = shift; my %opt = ((@_ % 2 ? 'mechanism' : ()), @_); my $self = bless { mechanism => $opt{mechanism} || $opt{mech}, callback => {}, debug => $opt{debug}, }, $pkg; $self->callback(%{$opt{callback}}) if ref($opt{callback}) eq 'HASH'; # Compat $self->callback(user => ($self->{user} = $opt{user})) if exists $opt{user}; $self->callback(pass => $opt{password}) if exists $opt{password}; $self->callback(pass => $opt{response}) if exists $opt{response}; $self; } sub mechanism { my $self = shift; @_ ? $self->{mechanism} = shift : $self->{mechanism}; } sub callback { my $self = shift; return $self->{callback}{$_[0]} if @_ == 1; my %new = @_; @{$self->{callback}}{keys %new} = values %new; $self->{callback}; } # The list of packages should not really be hardcoded here # We need some way to discover what plugins are installed sub client_new { # $self, $service, $host, $secflags my $self = shift; my $err; foreach my $pkg (@Plugins) { if (eval "require $pkg" and $pkg->can("client_new")) { if ($self->{conn} = eval { $pkg->client_new($self, @_) }) { return $self->{conn}; } $err = $@; } } croak $err || "Cannot find a SASL Connection library"; } sub server_new { # $self, $service, $host, $secflags my $self = shift; my $err; foreach my $pkg (@Plugins) { if (eval "require $pkg" and $pkg->can("server_new")) { if ($self->{conn} = eval { $pkg->server_new($self, @_) } ) { return $self->{conn}; } $err = $@; } } croak $err || "Cannot find a SASL Connection library for server-side authentication"; } sub error { my $self = shift; $self->{conn} && $self->{conn}->error; } # Compat. sub user { my $self = shift; my $user = $self->{callback}{user}; $self->{callback}{user} = shift if @_; $user; } sub challenge { my $self = shift; $self->{conn}->client_step(@_); } sub initial { my $self = shift; $self->client_new($self)->client_start; } sub name { my $self = shift; $self->{conn} ? $self->{conn}->mechanism : (($self->{mechanism} || '') =~ /(\S+)/)[0]; } 1; SASL.pod100644001750001750 1346415044402605 16211 0ustar00erikerik000000000000Authen-SASL-2.1900/lib/Authen=head1 NAME Authen::SASL - SASL Authentication framework =head1 VERSION version 2.1900 =head1 SYNOPSIS use Authen::SASL; $sasl = Authen::SASL->new( mechanism => 'CRAM-MD5 PLAIN ANONYMOUS', callback => { pass => \&fetch_password, user => $user, } ); =head1 DESCRIPTION SASL is a generic mechanism for authentication used by several network protocols. B provides an implementation framework that all protocols should be able to share. The framework allows different implementations of the connection class to be plugged in. At the time of writing there were two such plugins. =over 4 =item Authen::SASL::Perl This module implements several mechanisms and is implemented entirely in Perl. =item Authen::SASL::XS This module uses the Cyrus SASL C-library (both version 1 and 2 are supported). =item Authen::SASL::Cyrus This module is the predecessor to L. Until version 2.16, Authen::SASL::Cyrus was loaded as an alternative to Authen::SASL::XS. =back By default Authen::SASL tries to load Authen::SASL::XS first, followed by Authen::SASL::Perl on failure. If you want to change the order or want to specifically use one implementation only simply do use Authen::SASL qw(Perl); or if you have another plugin module that supports the Authen::SASL API use Authen::SASL qw(My::SASL::Plugin); =head2 CONTRUCTOR =over 4 =item new ( OPTIONS ) The constructor may be called with or without arguments. Passing arguments is just a short cut to calling the C and C methods. =over 4 =item callback =E { NAME => VALUE, NAME => VALUE, ... } Set the callbacks. See the L method for details. =item mechanism =E NAMES =item mech =E NAMES Set the list of mechanisms to choose from. See the L method for details. =item debug =E VALUE Set the debug level bit-value to C Debug output will be sent to C. The bits of this value are: 1 Show debug messages in the Perl modules for the mechanisms. (Currently only used in GSSAPI) 4 With security layers in place show information on packages read. 8 With security layers in place show information on packages written. The default value is 0. =back =back =head2 METHODS =over 4 =item mechanism ( ) Returns the current list of mechanisms =item mechanism ( NAMES ) Set the list of mechanisms to choose from. C should be a space separated string of the names. =item callback ( NAME ) Returns the current callback associated with C. =item callback ( NAME => VALUE, NAME => VALUE, ... ) Sets the given callbacks to the given values =item client_new ( SERVICE, HOST, SECURITY ) Creates and returns a new connection object for a client-side connection. =item server_new ( SERVICE, HOST, OPTIONS ) Creates and returns a new connection object for a server-side connection. =item error ( ) Returns any error from the last connection =back =head1 The Connection Class =over 4 =item server_start ( CHALLENGE ) server_start begins the authentication using the chosen mechanism. If the mechanism is not supported by the installed SASL it fails. Because for some mechanisms the client has to start the negotiation, you can give the client challenge as a parameter. =item server_step ( CHALLENGE ) server_step performs the next step in the negotiation process. The first parameter you give is the clients challenge/response. =item client_start ( ) The initial step to be performed. Returns the initial value to pass to the server or an empty list on error. =item client_step ( CHALLENGE ) This method is called when a response from the server requires it. CHALLENGE is the value from the server. Returns the next value to pass to the server or an empty list on error. =item need_step ( ) Returns true if the selected mechanism requires another step before completion (error or success). =item answer ( NAME ) The method will return the value returned from the last call to the callback NAME =item property ( NAME ) Returns the property value associated with C. =item property ( NAME => VALUE, NAME => VALUE, ... ) Sets the named properties to their associated values. =item service ( ) Returns the service argument that was passed to *_new-methods. =item host ( ) Returns the host argument that was passed to *_new-methods. =item mechanism ( ) Returns the name of the chosen mechanism. =item is_success ( ) Once need_step() returns false, then you can check if the authentication succeeded by calling this method which returns a boolean value. =back =head2 Callbacks There are three different ways in which a callback may be passed =over 4 =item CODEREF If the value passed is a code reference then, when needed, it will be called and the connection object will be passed as the first argument. In addition some callbacks may be passed additional arguments. =item ARRAYREF If the value passed is an array reference, the first element in the array must be a code reference. When the callback is called the code reference will be called with the connection object passed as the first argument and all other values from the array passed after. =item SCALAR All other values passed will be used directly. ie it is the same as passing an code reference that, when called, returns the value. =back =head1 SEE ALSO L, L, L =head1 MAINTAINER Erik Huelsmann =head1 AUTHOR Graham Barr =head1 BUGS Please report any bugs, or any suggestions, in the GitHub project at L. =head1 COPYRIGHT Copyright (c) 2023-2025 Erik Huelsmann Copyright (c) 1998-2005 Graham Barr. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut digest_md5.t100644001750001750 1601115044402605 16722 0ustar00erikerik000000000000Authen-SASL-2.1900/t/server#!perl use strict; use warnings; BEGIN { require Test::More; eval { require Digest::MD5 } or Test::More->import(skip_all => 'Need Digest::MD5'); eval { require Digest::HMAC_MD5 } or Test::More->import(skip_all => 'Need Digest::HMAC_MD5'); } use Test::More (tests => 33); use Authen::SASL qw(Perl); use_ok 'Authen::SASL::Perl::DIGEST_MD5'; my $authname; my $sasl = Authen::SASL->new( mechanism => 'DIGEST-MD5', callback => { getsecret => sub { $_[2]->('fred') }, }, ); ok($sasl,'new'); no warnings 'once'; # override for testing as by default it uses $$, time and rand $Authen::SASL::Perl::DIGEST_MD5::NONCE = "foobaz"; is($sasl->mechanism, 'DIGEST-MD5', 'sasl mechanism'); my $server = $sasl->server_new("ldap","elwood.innosoft.com", { no_integrity => 1 }); is($server->mechanism, 'DIGEST-MD5', 'conn mechanism'); ## simple success without authzid { my $expected_ss = join ",", 'algorithm=md5-sess', 'charset=utf-8', 'cipher="rc4,3des,des,rc4-56,rc4-40"', 'maxbuf=16777215', 'nonce="80338e79d2ca9b9c090ebaaa2ef293c7"', 'qop="auth"', 'realm="elwood.innosoft.com"'; my $ss; $server->server_start('', sub { $ss = shift }); is($ss, $expected_ss, 'server_start'); my $c1 = join ",", qw( charset=utf-8 cnonce="3858f62230ac3c915f300c664312c63f" digest-uri="ldap/elwood.innosoft.com" nc=00000001 nonce="80338e79d2ca9b9c090ebaaa2ef293c7" qop=auth realm="elwood.innosoft.com" response=39ab7388b1f52492b1b87cda55177d04 username="gbarr" ); my $s1; $server->server_step($c1, sub { $s1 = shift }); ok $server->is_success, "This is the first and only step"; ok !$server->error, "no error" or diag $server->error; ok !$server->need_step, "over"; is $server->property('ssf'), 0, "auth doesn't provide any protection"; is($s1, "rspauth=dbf4b44d397bafd53be835344988ec9d", "rspauth matches"); } # try with an authname { my $expected_ss = join ",", 'algorithm=md5-sess', 'charset=utf-8', 'cipher="rc4,3des,des,rc4-56,rc4-40"', 'maxbuf=16777215', 'nonce="80338e79d2ca9b9c090ebaaa2ef293c7"', 'qop="auth"', 'realm="elwood.innosoft.com"'; my $ss; $server->server_start('', sub { $ss = shift }); is($ss, $expected_ss, 'server_start'); ok !$server->is_success, "not success yet"; ok !$server->error, "no error" or diag $server->error; ok $server->need_step, "we need one more step"; $authname = 'meme'; my $c1 = join ",", qw( authzid="meme" charset=utf-8 cnonce="3858f62230ac3c915f300c664312c63f" digest-uri="ldap/elwood.innosoft.com" nc=00000002 nonce="80338e79d2ca9b9c090ebaaa2ef293c7" qop=auth realm="elwood.innosoft.com" response=e01f51543754aa665cfa2c621d59ee9e username="gbarr" ); my $s1; $server->server_step($c1, sub { $s1 = shift }); is($s1, "rspauth=d10458627b2b6bb553d796f4d805fdd1", "rspauth") or diag $server->error; ok $server->is_success, "success!"; ok !$server->error, "no error" or diag $server->error; ok !$server->need_step, "over"; is $server->property('ssf'), 0, "auth doesn't provide any protection"; } ## using auth-conf (if available) { SKIP: { skip "Crypt not available", 6 if $Authen::SASL::Perl::DIGEST_MD5::NO_CRYPT_AVAILABLE; $server = $sasl->server_new("ldap","elwood.innosoft.com"); my $expected_ss = join ",", 'algorithm=md5-sess', 'charset=utf-8', 'cipher="rc4,3des,des,rc4-56,rc4-40"', 'maxbuf=16777215', 'nonce="80338e79d2ca9b9c090ebaaa2ef293c7"', 'qop="auth,auth-conf,auth-int"', 'realm="elwood.innosoft.com"'; my $ss; $server->server_start('', sub { $ss = shift }); is($ss, $expected_ss, 'server_start'); my $c1 = join ",", qw( charset=utf-8 cnonce="3858f62230ac3c915f300c664312c63f" digest-uri="ldap/elwood.innosoft.com" nc=00000001 nonce="80338e79d2ca9b9c090ebaaa2ef293c7" qop=auth-conf realm="elwood.innosoft.com" response=e3c8b38d9bd9556761253e9879c4a8a2 username="gbarr" ); my $s1; $server->server_step($c1, sub { $s1 = shift }); ok $server->is_success, "This is the first and only step"; ok !$server->error, "no error" or diag $server->error; ok !$server->need_step, "over"; is($s1, "rspauth=1b1156d0e7f046bd0ea1476eb7d63a7b", "rspauth matches"); ## we have negociated the conf layer ok $server->property('ssf') > 1, "yes! secure layer set up"; }; } ## wrong challenge response { $server = $sasl->server_new("ldap","elwood.innosoft.com"); $server->server_start(''); my $c1 = join ",", qw( charset=utf-8 cnonce="3858f62230ac3c915f300c664312c63f" digest-uri="ldap/elwood.innosoft.com" nc=00000001 nonce="80338e79d2ca9b9c090ebaaa2ef293c7" qop=auth-conf realm="elwood.innosoft.com" response=nottherightone username="gbarr" ); $server->server_step($c1); ok !$server->is_success, "Bad challenge"; if ($Authen::SASL::Perl::DIGEST_MD5::NO_CRYPT_AVAILABLE) { like $server->error, qr/Client qop not supported/, $server->error; } else { like $server->error, qr/incorrect.*response/i, $server->error; } } ## multiple digest-uri; { $server = $sasl->server_new("ldap","elwood.innosoft.com"); $server->server_start(''); my $c1 = join ",", qw( charset=utf-8 cnonce="3858f62230ac3c915f300c664312c63f" digest-uri="ldap/elwood.innosoft.com" digest-uri="ldap/elwood.innosoft.com" nc=00000001 nonce="80338e79d2ca9b9c090ebaaa2ef293c7" qop=auth-conf realm="elwood.innosoft.com" response=e3c8b38d9bd9556761253e9879c4a8a2 username="gbarr" ); $server->server_step($c1); ok !$server->is_success, "Bad challenge"; like $server->error, qr/Bad.*challenge/i, $server->error; } ## nonce-count; { $server = $sasl->server_new("ldap","elwood.innosoft.com"); $server->server_start(''); my $c1 = join ",", qw( charset=utf-8 cnonce="3858f62230ac3c915f300c664312c63f" digest-uri="ldap/elwood.innosoft.com" nc=00000001 nonce="80338e79d2ca9b9c090ebaaa2ef293c7" qop=auth-conf realm="elwood.innosoft.com" response=e3c8b38d9bd9556761253e9879c4a8a2 username="gbarr" ); SKIP: { skip "no crypt available", 4 if $Authen::SASL::Perl::DIGEST_MD5::NO_CRYPT_AVAILABLE; $server->server_step($c1); ok $server->is_success, "first is success"; ok ! $server->error, "no error"; $server->server_step($c1); ok !$server->is_success, "replay attack"; like $server->error, qr/nonce-count.*match/i, $server->error; } } author-pod-syntax.t100644001750001750 45415044402605 16742 0ustar00erikerik000000000000Authen-SASL-2.1900/t#!perl BEGIN { unless ($ENV{AUTHOR_TESTING}) { print qq{1..0 # SKIP these tests are for testing by the author\n}; exit } } # 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(); negotiations000755001750001750 015044402605 15527 5ustar00erikerik000000000000Authen-SASL-2.1900/tlogin.t100644001750001750 267015044402605 17171 0ustar00erikerik000000000000Authen-SASL-2.1900/t/negotiations#!perl use Test::More tests => 9; use FindBin qw($Bin); require "$Bin/../lib/common.pl"; use Authen::SASL qw(Perl); use_ok('Authen::SASL::Perl::LOGIN'); ## base conf my $cconf = { sasl => { mechanism => 'LOGIN', callback => { user => 'yann', pass => 'maelys', }, }, host => 'localhost', service => 'xmpp', }; my $Password = 'maelys'; my $sconf = { sasl => { mechanism => 'LOGIN', callback => { getsecret => sub { $_[2]->($Password) }, }, }, host => 'localhost', service => 'xmpp', }; ## base negotiation should work negotiate($cconf, $sconf, sub { my ($clt, $srv) = @_; is $clt->mechanism, "LOGIN"; is $srv->mechanism, "LOGIN"; ok $clt->is_success, "client success" or diag $clt->error; ok $srv->is_success, "server success" or diag $srv->error; }); ## invalid password { # hey callback could just be a subref that returns a localvar $Password = "wrong"; negotiate($cconf, $sconf, sub { my ($clt, $srv) = @_; ok ! $srv->is_success, "wrong pass"; like $srv->error, qr/match/, "error set"; }); } ## invalid password with different callback { local $sconf->{sasl}{callback}{checkpass} = sub { $_[2]->(0) }; negotiate($cconf, $sconf, sub { my ($clt, $srv) = @_; ok ! $srv->is_success, "wrong pass"; like $srv->error, qr/match/, "error set"; }); } plain.t100644001750001750 266515044402605 17170 0ustar00erikerik000000000000Authen-SASL-2.1900/t/negotiations#!perl use Test::More tests => 9; use FindBin qw($Bin); require "$Bin/../lib/common.pl"; use Authen::SASL qw(Perl); use_ok('Authen::SASL::Perl::PLAIN'); ## base conf my $cconf = { sasl => { mechanism => 'PLAIN', callback => { user => 'yann', pass => 'maelys', }, }, host => 'localhost', service => 'xmpp', }; my $Password = 'maelys'; my $sconf = { sasl => { mechanism => 'PLAIN', callback => { getsecret => sub { $_[2]->($Password) }, }, }, host => 'localhost', service => 'xmpp', }; ## base negotiation should work negotiate($cconf, $sconf, sub { my ($clt, $srv) = @_; is $clt->mechanism, "PLAIN"; is $srv->mechanism, "PLAIN"; ok $clt->is_success, "client success" or diag $clt->error; ok $srv->is_success, "server success" or diag $srv->error; }); ## invalid password { # hey callback could just be a subref that returns a localvar $Password = "x"; negotiate($cconf, $sconf, sub { my ($clt, $srv) = @_; ok ! $srv->is_success, "wrong pass"; like $srv->error, qr/match/, "error set"; }); } ## invalid password with different callback { local $sconf->{sasl}{callback}{checkpass} = sub { $_[2]->(0) }; negotiate($cconf, $sconf, sub { my ($clt, $srv) = @_; ok ! $srv->is_success, "wrong pass"; like $srv->error, qr/match/, "error set"; }); } SASL000755001750001750 015044402605 15315 5ustar00erikerik000000000000Authen-SASL-2.1900/lib/AuthenPerl.pm100644001750001750 1765115044402605 16747 0ustar00erikerik000000000000Authen-SASL-2.1900/lib/Authen/SASL# Copyright (c) 2002 Graham Barr . All rights reserved. # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. package Authen::SASL::Perl 2.1900; use strict; use warnings; use Carp; my %secflags = ( noplaintext => 1, noanonymous => 1, nodictionary => 1, ); my %have; sub server_new { my ($pkg, $parent, $service, $host, $options) = @_; my $self = { callback => { %{$parent->callback} }, service => $service || '', host => $host || '', debug => $parent->{debug} || 0, need_step => 1, }; my $mechanism = $parent->mechanism or croak "No server mechanism specified"; $mechanism =~ s/^\s*\b(.*)\b\s*$/$1/g; $mechanism =~ s/-/_/g; $mechanism = uc $mechanism; my $mpkg = __PACKAGE__ . "::$mechanism"; eval "require $mpkg;" or croak "Cannot use $mpkg for " . $parent->mechanism; my $server = $mpkg->_init($self); $server->_init_server($options); return $server; } sub client_new { my ($pkg, $parent, $service, $host, $secflags) = @_; my @sec = grep { $secflags{$_} } split /\W+/, lc($secflags || ''); my $self = { callback => { %{$parent->callback} }, service => $service || '', host => $host || '', debug => $parent->{debug} || 0, need_step => 1, }; my @mpkg = sort { $b->_order <=> $a->_order } grep { my $have = $have{$_} ||= (eval "require $_;" and $_->can('_secflags')) ? 1 : -1; $have > 0 and $_->_secflags(@sec) == @sec and $_->_acceptable( %{$parent->callback} ) } map { (my $mpkg = __PACKAGE__ . "::$_") =~ s/-/_/g; $mpkg; } split /[^-\w]+/, $parent->mechanism or croak "No SASL mechanism found: ", $parent->mechanism, "\n"; $mpkg[0]->_init($self); } sub _init_server {} sub _acceptable { 1 } sub _order { 0 } sub code { defined(shift->{error}) || 0 } sub error { shift->{error} } sub service { shift->{service} } sub host { shift->{host} } sub need_step { my $self = shift; return 0 if $self->{error}; return $self->{need_step}; } ## I think I need to rename that to end()? ## It doesn't mean that SASL is successful, but that ## that the negotiation is over, no more step necessary ## at least for the client sub set_success { my $self = shift; $self->{need_step} = 0; } sub is_success { my $self = shift; return !$self->code && !$self->need_step; } sub set_error { my $self = shift; $self->{error} = shift; return; } # set/get property sub property { my $self = shift; my $prop = $self->{property} ||= {}; return $prop->{ $_[0] } if @_ == 1; my %new = @_; @{$prop}{keys %new} = values %new; 1; } sub callback { my $self = shift; return $self->{callback}{$_[0]} if @_ == 1; my %new = @_; @{$self->{callback}}{keys %new} = values %new; $self->{callback}; } # Should be defined in the mechanism sub-class sub mechanism { undef } sub client_step { undef } sub client_start { undef } sub server_step { undef } sub server_start { undef } # Private methods used by Authen::SASL::Perl that # may be overridden in mechanism sub-classes sub _init { my ($pkg, $href) = @_; bless $href, $pkg; } sub _call { my ($self, $name) = splice(@_,0,2); my $cb = $self->{callback}{$name}; return undef unless defined $cb; my $value; if (ref($cb) eq 'ARRAY') { my @args = @$cb; $cb = shift @args; $value = $cb->($self, @args); } elsif (ref($cb) eq 'CODE') { $value = $cb->($self, @_); } else { $value = $cb; } $self->{answer}{$name} = $value unless $name eq 'pass'; # Do not store password return $value; } # TODO: Need a better name than this sub answer { my ($self, $name) = @_; $self->{answer}{$name}; } sub _secflags { 0 } sub securesocket { my $self = shift; return $_[0] unless (defined($self->property('ssf')) && $self->property('ssf') > 0); local *GLOB; # avoid used only once warning my $glob = \do { local *GLOB; }; tie(*$glob, 'Authen::SASL::Perl::Layer', $_[0], $self); $glob; } { # # Add SASL encoding/decoding to a filehandle # package # private package; prevent detection by MetaCPAN Authen::SASL::Perl::Layer; use bytes; require Tie::Handle; our @ISA = qw(Tie::Handle); sub TIEHANDLE { my ($class, $fh, $conn) = @_; my $self; warn __PACKAGE__ . ': non-blocking handle may not work' if ($fh->can('blocking') and not $fh->blocking()); $self->{fh} = $fh; $self->{conn} = $conn; $self->{readbuflen} = 0; $self->{sndbufsz} = $conn->property('maxout'); $self->{rcvbufsz} = $conn->property('maxbuf'); return bless($self, $class); } sub CLOSE { my ($self) = @_; # forward close to the inner handle close($self->{fh}); delete $self->{fh}; } sub DESTROY { my ($self) = @_; delete $self->{fh}; undef $self; } sub FETCH { my ($self) = @_; return $self->{fh}; } sub FILENO { my ($self) = @_; return fileno($self->{fh}); } sub READ { my ($self, $buf, $len, $offset) = @_; my $debug = $self->{conn}->{debug}; $buf = \$_[1]; my $avail = $self->{readbuflen}; print STDERR " [READ(len=$len,offset=$offset)] avail=$avail;\n" if ($debug & 4); # Check if there's leftovers from a previous READ if ($avail <= 0) { $avail = $self->_getbuf(); return undef unless ($avail > 0); } # if there's more than we need right now, leave the rest for later if ($avail >= $len) { print STDERR " GOT ALL: avail=$avail; need=$len\n" if ($debug & 4); substr($$buf, $offset, $len) = substr($self->{readbuf}, 0, $len, ''); $self->{readbuflen} -= $len; return ($len); } # there's not enough; take all we have, read more on next call print STDERR " GOT PARTIAL: avail=$avail; need=$len\n" if ($debug & 4); substr($$buf, $offset || 0, $avail) = $self->{readbuf}; $self->{readbuf} = ''; $self->{readbuflen} = 0; return ($avail); } # retrieve and decode a buffer of cipher text in SASL format sub _getbuf { my ($self) = @_; my $debug = $self->{conn}->{debug}; my $fh = $self->{fh}; my $buf = ''; # first, read 4-octet buffer size my $n = 0; while ($n < 4) { my $rv = sysread($fh, $buf, 4 - $n, $n); print STDERR " [getbuf: sysread($fh,$buf,4-$n,$n)=$rv: $!\n" if ($debug & 4); return $rv unless $rv > 0; $n += $rv; } # size is encoded in network byte order my ($bsz) = unpack('N', $buf); print STDERR " [getbuf: cipher buffer sz=$bsz]\n" if ($debug & 4); return undef unless ($bsz <= $self->{rcvbufsz}); # next, read actual cipher text $buf = ''; $n = 0; while ($n < $bsz) { my $rv = sysread($fh, $buf, $bsz - $n, $n); print STDERR " [getbuf: got o=$n,n=", $bsz - $n, ",rv=$rv,bl=" . length($buf) . "]\n" if ($debug & 4); return $rv unless $rv > 0; $n += $rv; } # call mechanism specific decoding routine $self->{readbuf} = $self->{conn}->decode($buf, $bsz); $n = length($self->{readbuf}); print STDERR " [getbuf: clear text buffer sz=$n]\n" if ($debug & 4); $self->{readbuflen} = $n; } # Encrypting a write() to a filehandle is much easier than reading, because # all the data to be encrypted is immediately available sub WRITE { my ($self, $data, $len, $offset) = @_; my $debug = $self->{conn}->{debug}; my $fh = $self->{fh}; $len = length($data) if $len > length($data); # RT 85294 # put on wire in peer-sized chunks my $bsz = $self->{sndbufsz}; while ($len > 0) { print STDERR " [WRITE: chunk $bsz/$len]\n" if ($debug & 8); # call mechanism specific encoding routine my $x = $self->{conn}->encode(substr($data, $offset || 0, $bsz)); print $fh pack('N', length($x)), $x; $len -= $bsz; $offset += $bsz; } return $_[2]; } } 1; digest_md5_verified.t100644001750001750 332715044402605 17257 0ustar00erikerik000000000000Authen-SASL-2.1900/t#!perl BEGIN { require Test::More; eval { require Digest::MD5 } or Test::More->import(skip_all => 'Need Digest::MD5'); eval { require Digest::HMAC_MD5 } or Test::More->import(skip_all => 'Need Digest::HMAC_MD5'); } use Test::More (tests => 8); use Authen::SASL qw(Perl); my $authname; my $sasl = Authen::SASL->new( mechanism => 'DIGEST-MD5', callback => { user => 'fred', pass => 'gladys', authname => sub { $authname }, }, ); ok($sasl,'new'); is($sasl->mechanism, 'DIGEST-MD5', 'sasl mechanism'); my $conn = $sasl->client_new("sieve","imap.spodhuis.org", "noplaintext noanonymous"); is($conn->mechanism, 'DIGEST-MD5', 'conn mechanism'); is($conn->client_start, '', 'client_start'); my $sparams = 'nonce="YPymzyi3YH8OILTBvSIuaul7RD3fIANDT2akHE6auBE=",realm="imap.spodhuis.org",qop="auth",maxbuf=4096,charset=utf-8,algorithm=md5-sess'; # override for testing as by default it uses $$, time and rand $Authen::SASL::Perl::DIGEST_MD5::CNONCE = "foobar"; $Authen::SASL::Perl::DIGEST_MD5::CNONCE = "foobar"; # avoid used only once warning my $initial = $conn->client_step($sparams); ok(!$conn->code(), "SASL error: " . ($conn->code() ? $conn->error() : '')); my @expect = qw( charset=utf-8 cnonce="3858f62230ac3c915f300c664312c63f" digest-uri="sieve/imap.spodhuis.org" nc=00000001 nonce="YPymzyi3YH8OILTBvSIuaul7RD3fIANDT2akHE6auBE=" qop=auth realm="imap.spodhuis.org" response=3743421076899a855bafec1f7a9ed58a username="fred" ); is( $initial, join(",", @expect), 'client_step' ); my $second = $conn->client_step('rspauth=4593215e1a0613328324b8325b975d96'); ok(!$conn->code(), "SASL error: " . ($conn->code() ? $conn->error() : '')); is( $second, '', 'client_step final verification' ); Perl.pod100644001750001750 1213315044402605 17103 0ustar00erikerik000000000000Authen-SASL-2.1900/lib/Authen/SASL# Copyright (c) 2004-2006 Peter Marschall . # Copyright (c) 2025 Aditya Garg . # All rights reserved. # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. =head1 NAME Authen::SASL::Perl -- Perl implementation of the SASL Authentication framework =head1 VERSION version 2.1900 =head1 SYNOPSIS use Authen::SASL qw(Perl); $sasl = Authen::SASL->new( mechanism => 'CRAM-MD5 PLAIN ANONYMOUS', callback => { user => $user, pass => \&fetch_password } ); =head1 DESCRIPTION B is the pure Perl implementation of SASL mechanisms in the B framework. At the time of this writing it provides the client part implementation for the following SASL mechanisms: =over 4 =item ANONYMOUS The Anonymous SASL Mechanism as defined in RFC 2245 resp. in IETF Draft draft-ietf-sasl-anon-03.txt from February 2004 provides a method to anonymously access internet services. Since it does no authentication it does not need to send any confidential information such as passwords in plain text over the network. =item CRAM-MD5 The CRAM-MD5 SASL Mechanism as defined in RFC2195 resp. in IETF Draft draft-ietf-sasl-crammd5-XX.txt offers a simple challenge-response authentication mechanism. Since it is a challenge-response authentication mechanism no passwords are transferred in clear-text over the wire. Due to the simplicity of the protocol CRAM-MD5 is susceptible to replay and dictionary attacks, so DIGEST-MD5 should be used in preference. =item DIGEST-MD5 The DIGEST-MD5 SASL Mechanism as defined in RFC 2831 resp. in IETF Draft draft-ietf-sasl-rfc2831bis-XX.txt offers the HTTP Digest Access Authentication as SASL mechanism. Like CRAM-MD5 it is a challenge-response authentication method that does not send plain text passwords over the network. Compared to CRAM-MD5, DIGEST-MD5 prevents chosen plaintext attacks, and permits the use of third party authentication servers, so that it is recommended to use DIGEST-MD5 instead of CRAM-MD5 when possible. =item EXTERNAL The EXTERNAL SASL mechanism as defined in RFC 2222 allows the use of external authentication systems as SASL mechanisms. =item GSSAPI The GSSAPI SASL mechanism as defined in RFC 2222 resp. IETF Draft draft-ietf-sasl-gssapi-XX.txt allows using the Generic Security Service Application Program Interface [GSSAPI] KERBEROS V5 as a SASL mechanism. Although GSSAPI is a general mechanism for authentication it is almost exclusively used for Kerberos 5. =item LOGIN The LOGIN SASL Mechanism as defined in IETF Draft draft-murchison-sasl-login-XX.txt allows the combination of username and clear-text password to be used in a SASL mechanism. It does not provide a security layer and sends the credentials in clear over the wire. Thus this mechanism should not be used without adequate security protection. =item OAUTHBEARER It is one of the methods for OAuth2.0 based authentication. Instead of a password, an OAUTHBEARER string is passed in a specific format, described in RFC5801 and RFC7628 It is a newer and more secure method of authentication since it relies on tokens that have a limited lifespan. =item PLAIN The Plain SASL Mechanism as defined in RFC 2595 resp. IETF Draft draft-ietf-sasl-plain-XX.txt is another SASL mechanism that allows username and clear-text password combinations in SASL environments. Like LOGIN it sends the credentials in clear over the network and should not be used without sufficient security protection. =item XOAUTH2 It is one of the methods for OAuth2.0 based authentication. It has been developed by Google but is used by other email providers like Outlook as well. Instead of a password, an XOAUTH2 string is passed in a specific format. It is documented by Google on: https://developers.google.com/workspace/gmail/imap/xoauth2-protocol It is a newer and more secure method of authentication since it relies on tokens that have a limited lifespan. =back As for server support, only I, I and I are supported at the time of this writing. C OPTIONS is a hashref that is only relevant for I for now and it supports the following options: =over 4 =item - no_integrity =item - no_confidentiality =back which configures how the security layers are negotiated with the client (or rather imposed to the client). =head1 SEE ALSO L, L, L, L, L, L, L, L, L, L =head1 AUTHOR Peter Marschall =head1 CONTRIBUTORS Aditya Garg Robert Rothenberg Please report any bugs, or post any suggestions, to the perl-ldap mailing list =head1 COPYRIGHT Copyright (c) 2004-2006 Peter Marschall. Copyright (c) 2025 Aditya Garg. All rights reserved. This document is distributed, and may be redistributed, under the same terms as Perl itself. =cut CRAM_MD5.pm100644001750001750 73215044402605 17164 0ustar00erikerik000000000000Authen-SASL-2.1900/lib/Authen/SASL# Copyright (c) 2002 Graham Barr . All rights reserved. # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. package Authen::SASL::CRAM_MD5 2.1900; use strict; use warnings; warnings::warnif( 'deprecated', 'The CRAM-MD5 SASL mechanism is effectively deprecated by RFC8314 and should no longer be used' ); sub new { shift; Authen::SASL->new(@_, mechanism => 'CRAM-MD5'); } 1; EXTERNAL.pm100644001750001750 51315044402605 17214 0ustar00erikerik000000000000Authen-SASL-2.1900/lib/Authen/SASL# Copyright (c) 2002 Graham Barr . All rights reserved. # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. package Authen::SASL::EXTERNAL 2.1900; use strict; use warnings; sub new { shift; Authen::SASL->new(@_, mechanism => 'EXTERNAL'); } 1; digest_md5.t100644001750001750 367115044402605 20107 0ustar00erikerik000000000000Authen-SASL-2.1900/t/negotiations#!perl use strict; use warnings; use Test::More tests => 11; use FindBin qw($Bin); require "$Bin/../lib/common.pl"; ## base conf my $cconf = { sasl => { mechanism => 'DIGEST-MD5', callback => { user => 'yann', pass => 'maelys', }, }, host => 'localhost', security => 'noanonymous', service => 'xmpp', }; my $sconf = { sasl => { mechanism => 'DIGEST-MD5', callback => { getsecret => sub { $_[2]->('maelys') }, }, }, host => 'localhost', service => 'xmpp', }; ## base negotiation should work negotiate($cconf, $sconf, sub { my ($clt, $srv) = @_; ok $clt->is_success, "client success" or diag $clt->error; ok $srv->is_success, "server success" or diag $srv->error; }); ## invalid password { local $cconf->{sasl}{callback}{pass} = "YANN"; negotiate($cconf, $sconf, sub { my ($clt, $srv) = @_; ok !$srv->is_success, "failure"; like $srv->error, qr/response/; }); } ## arguments passed to server pass callback { local $cconf->{sasl}{callback}{authname} = "some authzid"; local $sconf->{sasl}{callback}{getsecret} = sub { my $server = shift; my ($args, $cb) = @_; is $args->{user}, "yann", "username"; is $args->{realm}, "localhost", "realm"; is $args->{authzid}, "some authzid", "authzid"; $cb->("incorrect"); }; negotiate($cconf, $sconf, sub { my ($clt, $srv) = @_; ok !$srv->is_success, "failure"; like $srv->error, qr/response/, "incorrect response"; }); } ## digest-uri checking { local $cconf->{host} = "elsewhere"; local $cconf->{service} = "pop3"; negotiate($cconf, $sconf, sub { my ($clt, $srv) = @_; ok !$srv->is_success, "failure"; my $error = $srv->error || ""; like $error, qr/incorrect.*digest.*uri/i, "incorrect digest uri"; }); } Perl000755001750001750 015044402605 16217 5ustar00erikerik000000000000Authen-SASL-2.1900/lib/Authen/SASLLOGIN.pm100644001750001750 1070615044402605 17611 0ustar00erikerik000000000000Authen-SASL-2.1900/lib/Authen/SASL/Perl# Copyright (c) 2002 Graham Barr . All rights reserved. # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. package Authen::SASL::Perl::LOGIN 2.1900; use strict; use warnings; use vars qw(@ISA); @ISA = qw(Authen::SASL::Perl); my %secflags = ( noanonymous => 1, ); sub _order { 1 } sub _secflags { shift; scalar grep { $secflags{$_} } @_; } sub mechanism { 'LOGIN' } sub client_start { my $self = shift; $self->{stage} = 0; ''; } sub client_step { my ($self, $string) = @_; # XXX technically this is wrong. I might want to change that. # spec say it's "staged" and that the content of the challenge doesn't # matter # actually, let's try my $stage = ++$self->{stage}; if ($stage == 1) { return $self->_call('user'); } elsif ($stage == 2) { return $self->_call('pass'); } elsif ($stage == 3) { $self->set_success; return; } else { return $self->set_error("Invalid sequence"); } } sub server_start { my $self = shift; my $response = shift; my $user_cb = shift || sub {}; $self->{answer} = {}; $self->{stage} = 0; $self->{need_step} = 1; $self->{error} = undef; $user_cb->('Username:'); return; } sub server_step { my $self = shift; my $response = shift; my $user_cb = shift || sub {}; my $stage = ++$self->{stage}; if ($stage == 1) { unless (defined $response) { $self->set_error("Invalid sequence (empty username)"); return $user_cb->(); } $self->{answer}{user} = $response; return $user_cb->("Password:"); } elsif ($stage == 2) { unless (defined $response) { $self->set_error("Invalid sequence (empty pass)"); return $user_cb->(); } $self->{answer}{pass} = $response; } else { $self->set_error("Invalid sequence (end)"); return $user_cb->(); } my $error = "Credentials don't match"; my $answers = { user => $self->{answer}{user}, pass => $self->{answer}{pass} }; if (my $checkpass = $self->{callback}{checkpass}) { my $cb = sub { my $result = shift; unless ($result) { $self->set_error($error); } else { $self->set_success; } $user_cb->(); }; $checkpass->($self => $answers => $cb ); return; } elsif (my $getsecret = $self->{callback}{getsecret}) { my $cb = sub { my $good_pass = shift; if ($good_pass && $good_pass eq ($self->{answer}{pass} || "")) { $self->set_success; } else { $self->set_error($error); } $user_cb->(); }; $getsecret->($self => $answers => $cb ); return; } else { $self->set_error($error); $user_cb->(); } return; } 1; __END__ =head1 NAME Authen::SASL::Perl::LOGIN - Login Authentication class =head1 VERSION version 2.1900 =head1 SYNOPSIS use Authen::SASL qw(Perl); $sasl = Authen::SASL->new( mechanism => 'LOGIN', callback => { user => $user, pass => $pass }, ); =head1 DESCRIPTION This method implements the client and server part of the LOGIN SASL algorithm, as described in IETF Draft draft-murchison-sasl-login-XX.txt. =head2 CALLBACK The callbacks used are: =head3 Client =over 4 =item user The username to be used for authentication =item pass The user's password to be used for authentication =back =head3 Server =over 4 =item getsecret(username) returns the password associated with C =item checkpass(username, password) returns true and false depending on the validity of the credentials passed in arguments. =back =head1 SEE ALSO L, L =head1 AUTHORS Software written by Graham Barr , documentation written by Peter Marschall . Server support by Yann Kerherve Please report any bugs, or post any suggestions, to the perl-ldap mailing list =head1 COPYRIGHT Copyright (c) 2002-2004 Graham Barr. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Documentation Copyright (c) 2004 Peter Marschall. All rights reserved. This documentation is distributed, and may be redistributed, under the same terms as Perl itself. Server support Copyright (c) 2009 Yann Kerherve. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut PLAIN.pm100644001750001750 716415044402605 17570 0ustar00erikerik000000000000Authen-SASL-2.1900/lib/Authen/SASL/Perl# Copyright (c) 2002 Graham Barr . All rights reserved. # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. package Authen::SASL::Perl::PLAIN 2.1900; use strict; use warnings; use vars qw(@ISA); @ISA = qw(Authen::SASL::Perl); my %secflags = ( noanonymous => 1, ); my @tokens = qw(authname user pass); sub _order { 1 } sub _secflags { shift; grep { $secflags{$_} } @_; } sub mechanism { 'PLAIN' } sub client_start { my $self = shift; $self->{error} = undef; $self->{need_step} = 0; my @parts = map { my $v = $self->_call($_); defined($v) ? $v : '' } @tokens; join("\0", @parts); } sub server_start { my $self = shift; my $response = shift; my $user_cb = shift || sub {}; $self->{error} = undef; return $self->set_error("No response: Credentials don't match") unless defined $response; my %parts; @parts{@tokens} = split "\0", $response, scalar @tokens; # I'm not entirely sure of what I am doing $self->{answer}{$_} = $parts{$_} for qw/authname user/; my $error = "Credentials don't match"; ## checkpass if (my $checkpass = $self->callback('checkpass')) { my $cb = sub { my $result = shift; unless ($result) { $self->set_error($error); } else { $self->set_success; } $user_cb->(); }; $checkpass->($self => { %parts } => $cb ); return; } ## getsecret elsif (my $getsecret = $self->callback('getsecret')) { my $cb = sub { my $good_pass = shift; if ($good_pass && $good_pass eq ($parts{pass} || "")) { $self->set_success; } else { $self->set_error($error); } $user_cb->(); }; $getsecret->( $self, { map { $_ => $parts{$_ } } qw/user authname/ }, $cb ); return; } ## error by default else { $self->set_error($error); $user_cb->(); } } 1; __END__ =head1 NAME Authen::SASL::Perl::PLAIN - Plain Login Authentication class =head1 VERSION version 2.1900 =head1 SYNOPSIS use Authen::SASL qw(Perl); $sasl = Authen::SASL->new( mechanism => 'PLAIN', callback => { user => $user, pass => $pass }, ); =head1 DESCRIPTION This method implements the client and server part of the PLAIN SASL algorithm, as described in RFC 2595 resp. IETF Draft draft-ietf-sasl-plain-XX.txt =head2 CALLBACK The callbacks used are: =head3 Client =over 4 =item authname The authorization id to use after successful authentication (client) =item user The username to be used for authentication (client) =item pass The user's password to be used for authentication. =back =head3 Server =over 4 =item checkpass(username, password, realm) returns true and false depending on the validity of the credentials passed in arguments. =back =head1 SEE ALSO L, L =head1 AUTHORS Software written by Graham Barr , documentation written by Peter Marschall . Please report any bugs, or post any suggestions, to the perl-ldap mailing list =head1 COPYRIGHT Copyright (c) 2002-2004 Graham Barr. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Documentation Copyright (c) 2004 Peter Marschall. All rights reserved. This documentation is distributed, and may be redistributed, under the same terms as Perl itself. Server support Copyright (c) 2009 Yann Kerherve. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut GSSAPI.pm100644001750001750 2513715044402605 17733 0ustar00erikerik000000000000Authen-SASL-2.1900/lib/Authen/SASL/Perl# Copyright (c) 2006 Simon Wilkinson # All rights reserved. This program is free software; you can redistribute # it and/or modify it under the same terms as Perl itself. package Authen::SASL::Perl::GSSAPI 2.1900; use strict; use warnings; use vars qw(@ISA); use GSSAPI; @ISA = qw(Authen::SASL::Perl); my %secflags = ( noplaintext => 1, noanonymous => 1, ); sub _order { 4 } sub _secflags { shift; scalar grep { $secflags{$_} } @_; } sub mechanism { 'GSSAPI' } sub _init { my ($pkg, $self) = @_; bless $self, $pkg; # set default security properties $self->property('minssf', 0); $self->property('maxssf', int 2**31 - 1); # XXX - arbitrary "high" value $self->property('maxbuf', 0xFFFFFF); # maximum supported by GSSAPI mech $self->property('externalssf', 0); # the cyrus sasl library allows only one bit to be set in the # layer selection mask in the client reply, we default to # compatibility with that bug $self->property('COMPAT_CYRUSLIB_REPLY_MASK_BUG', 1); $self; } sub client_start { my $self = shift; my $status; my $principal = $self->service.'@'.$self->host; # GSSAPI::Name->import is the *constructor*, # storing the new GSSAPI::Name into $target. # GSSAPI::Name->import is not the standard # import() method as used in Perl normally my $target; $status = GSSAPI::Name->import($target, $principal, gss_nt_service_name) or return $self->set_error("GSSAPI Error : ".$status); $self->{gss_name} = $target; $self->{gss_ctx} = new GSSAPI::Context; $self->{gss_state} = 0; $self->{gss_layer} = undef; my $cred = $self->_call('pass'); $self->{gss_cred} = (ref($cred) && $cred->isa('GSSAPI::Cred')) ? $cred : GSS_C_NO_CREDENTIAL; $self->{gss_mech} = $self->_call('gssmech') || gss_mech_krb5; # reset properties for new session $self->property(maxout => undef); $self->property(ssf => undef); return $self->client_step(''); } sub client_step { my ($self, $challenge) = @_; my $debug = $self->{debug}; my $status; if ($self->{gss_state} == 0) { my $outtok; my $inflags = GSS_C_INTEG_FLAG | GSS_C_MUTUAL_FLAG;#todo:set according to ssf props my $outflags; $status = $self->{gss_ctx}->init($self->{gss_cred}, $self->{gss_name}, $self->{gss_mech}, $inflags, 0, GSS_C_NO_CHANNEL_BINDINGS, $challenge, undef, $outtok, $outflags, undef); print STDERR "state(0): ". $status->generic_message.';'.$status->specific_message. "; output token sz: ".length($outtok)."\n" if ($debug & 1); if (GSSAPI::Status::GSS_ERROR($status->major)) { return $self->set_error("GSSAPI Error (init): ".$status); } if ($status->major == GSS_S_COMPLETE) { $self->{gss_state} = 1; } return $outtok; } elsif ($self->{gss_state} == 1) { # If the server has an empty output token when it COMPLETEs, Cyrus SASL # kindly sends us that empty token. We need to ignore it, which introduces # another round into the process. print STDERR " state(1): challenge is EMPTY\n" if ($debug and $challenge eq ''); return '' if ($challenge eq ''); my $unwrapped; $status = $self->{gss_ctx}->unwrap($challenge, $unwrapped, undef, undef) or return $self->set_error("GSSAPI Error (unwrap challenge): ".$status); return $self->set_error("GSSAPI Error : invalid security layer token") if (length($unwrapped) != 4); # the security layers the server supports: bitmask of # 1 = no security layer, # 2 = integrity protection, # 4 = confidentiality protection # which is encoded in the first octet of the response; # the remote maximum buffer size is encoded in the next three octets # my $layer = ord(substr($unwrapped, 0, 1, chr(0))); my ($rsz) = unpack('N',$unwrapped); # get local receive buffer size my $lsz = $self->property('maxbuf'); # choose security layer my $choice = $self->_layer($layer,$rsz,$lsz); return $self->set_error("GSSAPI Error: security too weak") unless $choice; $self->{gss_layer} = $choice; if ($choice > 1) { # determine maximum plain text message size for peer's cipher buffer my $psz; $status = $self->{gss_ctx}->wrap_size_limit($choice & 4, 0, $rsz, $psz) or return $self->set_error("GSSAPI Error (wrap size): ".$status); return $self->set_error("GSSAPI wrap size = 0") unless ($psz); $self->property(maxout => $psz); # set SSF property; if we have just integrity protection SSF is set # to 1. If we have confidentiality, SSF would be an estimate of the # strength of the actual encryption ciphers in use which is not # available through the GSSAPI interface; for now just set it to # the lowest value that signifies confidentiality. $self->property(ssf => (($choice & 4) ? 2 : 1)); } else { # our advertised buffer size should be 0 if no layer selected $lsz = 0; $self->property(ssf => 0); } print STDERR "state(1): layermask $layer,rsz $rsz,lsz $lsz,choice $choice\n" if ($debug & 1); my $message = pack('CCCC', $choice, ($lsz >> 16)&0xff, ($lsz >> 8)&0xff, $lsz&0xff); # append authorization identity if we have one my $authz = $self->_call('authname'); $message .= $authz if ($authz); my $outtok; $status = $self->{gss_ctx}->wrap(0, 0, $message, undef, $outtok) or return $self->set_error("GSSAPI Error (wrap token): ".$status); $self->{gss_state} = 0; return $outtok; } } # default layer selection sub _layer { my ($self, $theirmask, $rsz, $lsz) = @_; my $maxssf = $self->property('maxssf') - $self->property('externalssf'); $maxssf = 0 if ($maxssf < 0); my $minssf = $self->property('minssf') - $self->property('externalssf'); $minssf = 0 if ($minssf < 0); return undef if ($maxssf < $minssf); # sanity check # ssf values > 1 mean integrity and confidentiality # ssf == 1 means integrity but no confidentiality # ssf < 1 means neither integrity nor confidentiality # no security layer can be had if buffer size is 0 my $ourmask = 0; $ourmask |= 1 if ($minssf < 1); $ourmask |= 2 if ($minssf <= 1 and $maxssf >= 1); $ourmask |= 4 if ($maxssf > 1); $ourmask &= 1 unless ($rsz and $lsz); # mask the bits they don't have $ourmask &= $theirmask; return $ourmask unless $self->property('COMPAT_CYRUSLIB_REPLY_MASK_BUG'); # in cyrus sasl bug compat mode, select the highest bit set return 4 if ($ourmask & 4); return 2 if ($ourmask & 2); return 1 if ($ourmask & 1); return undef; } sub encode { # input: self, plaintext buffer,length (length not used here) my $self = shift; my $wrapped; my $status = $self->{gss_ctx}->wrap($self->{gss_layer} & 4, 0, $_[0], undef, $wrapped); $self->set_error("GSSAPI Error (encode): " . $status), return unless ($status); return $wrapped; } sub decode { # input: self, cipher buffer,length (length not used here) my $self = shift; my $unwrapped; my $status = $self->{gss_ctx}->unwrap($_[0], $unwrapped, undef, undef); $self->set_error("GSSAPI Error (decode): " . $status), return unless ($status); return $unwrapped; } __END__ =head1 NAME Authen::SASL::Perl::GSSAPI - GSSAPI (Kerberosv5) Authentication class =head1 VERSION version 2.1900 =head1 SYNOPSIS use Authen::SASL qw(Perl); $sasl = Authen::SASL->new( mechanism => 'GSSAPI' ); $sasl = Authen::SASL->new( mechanism => 'GSSAPI', callback => { pass => $mycred }); $sasl->client_start( $service, $host ); =head1 DESCRIPTION This method implements the client part of the GSSAPI SASL algorithm, as described in RFC 2222 section 7.2.1 resp. draft-ietf-sasl-gssapi-XX.txt. With a valid Kerberos 5 credentials cache (aka TGT) it allows to connect to I@I given as the first two parameters to Authen::SASL's client_start() method. Alternatively, a GSSAPI::Cred object can be passed in via the Authen::SASL callback hash using the `pass' key. Please note that this module does not currently implement a SASL security layer following authentication. Unless the connection is protected by other means, such as TLS, it will be vulnerable to man-in-the-middle attacks. If security layers are required, then the L GSSAPI module should be used instead. =head2 CALLBACK The callbacks used are: =over 4 =item authname The authorization identity to be used in SASL exchange =item gssmech The GSS mechanism to be used in the connection =item pass The GSS credentials to be used in the connection (optional) =back =head1 EXAMPLE #! /usr/bin/perl -w use strict; use warnings; use Net::LDAP 0.33; use Authen::SASL 2.10; # -------- Adjust to your environment -------- my $adhost = 'theserver.bla.net'; my $ldap_base = 'dc=bla,dc=net'; my $ldap_filter = '(&(sAMAccountName=BLAAGROL))'; my $sasl = Authen::SASL->new(mechanism => 'GSSAPI'); my $ldap; eval { $ldap = Net::LDAP->new($adhost, onerror => 'die') or die "Cannot connect to LDAP host '$adhost': '$@'"; $ldap->bind(sasl => $sasl); }; if ($@) { chomp $@; die "\nBind error : $@", "\nDetailed SASL error: ", $sasl->error, "\nTerminated"; } print "\nLDAP bind() succeeded, working in authenticated state"; my $mesg = $ldap->search(base => $ldap_base, filter => $ldap_filter); # -------- evaluate $mesg =head2 PROPERTIES The properties used are: =over 4 =item maxbuf The maximum buffer size for receiving cipher text =item minssf The minimum SSF value that should be provided by the SASL security layer. The default is 0 =item maxssf The maximum SSF value that should be provided by the SASL security layer. The default is 2**31 =item externalssf The SSF value provided by an underlying external security layer. The default is 0 =item ssf The actual SSF value provided by the SASL security layer after the SASL authentication phase has been completed. This value is read-only and set by the implementation after the SASL authentication phase has been completed. =item maxout The maximum plaintext buffer size for sending data to the peer. This value is set by the implementation after the SASL authentication phase has been completed and a SASL security layer is in effect. =back =head1 SEE ALSO L, L =head1 AUTHORS Written by Simon Wilkinson, with patches and extensions by Achim Grolms and Peter Marschall. Please report any bugs, or post any suggestions, to the perl-ldap mailing list =head1 COPYRIGHT Copyright (c) 2006 Simon Wilkinson, Achim Grolms and Peter Marschall. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut XOAUTH2.pm100644001750001750 434615044402605 20016 0ustar00erikerik000000000000Authen-SASL-2.1900/lib/Authen/SASL/Perl# Copyright (c) 2025 Aditya Garg # Copyright (c) 2025 Julian Swagemakers # All rights reserved. # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. package Authen::SASL::Perl::XOAUTH2 2.1900; use strict; use vars qw(@ISA); use JSON::PP; @ISA = qw(Authen::SASL::Perl); my %secflags = ( noanonymous => 1, ); sub _order { 1 } sub _secflags { shift; scalar grep { $secflags{$_} } @_; } sub mechanism { 'XOAUTH2' } sub client_start { my $self = shift; $self->{stage} = 0; # "user=" {User} "^Aauth=Bearer " {Access Token} "^A^A" # https://developers.google.com/gmail/imap/xoauth2-protocol#initial_client_response my $username = $self->_call('user'); my $token = $self->_call('pass'); # OAuth 2.0 access token my $auth_string = "user=$username\001auth=Bearer $token\001\001"; return $auth_string } sub client_step { my ($self, $challenge) = @_; my $json = JSON::PP->new; my $payload = $json->decode( $challenge ); $self->set_error( $payload ); # Send dummy request on authentication failure according to rfc7628. # https://datatracker.ietf.org/doc/html/rfc7628#section-3.2.3 return "\001"; } 1; __END__ =head1 NAME Authen::SASL::Perl::XOAUTH2 - XOAUTH2 Authentication class =head1 VERSION version 2.1900 =head1 SYNOPSIS use Authen::SASL qw(Perl); $sasl = Authen::SASL->new( mechanism => 'XOAUTH2', callback => { user => $user, pass => $access_token }, ); =head1 DESCRIPTION This module implements the client side of the XOAUTH2 SASL mechanism, which is used for OAuth 2.0-based authentication. =head2 CALLBACK The callbacks used are: =head3 Client =over 4 =item user The username to be used for authentication. =item pass The OAuth 2.0 access token to be used for authentication. =back =head1 SEE ALSO L, L =head1 AUTHORS Written by Aditya Garg and Julian Swagemakers. =head1 COPYRIGHT Copyright (c) 2025 Aditya Garg. Copyright (c) 2025 Julian Swagemakers. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut CRAM_MD5.pm100644001750001750 471415044402605 20112 0ustar00erikerik000000000000Authen-SASL-2.1900/lib/Authen/SASL/Perl# Copyright (c) 2002 Graham Barr . All rights reserved. # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. package Authen::SASL::Perl::CRAM_MD5 2.1900; use strict; use warnings; use vars qw(@ISA); use Digest::HMAC_MD5 qw(hmac_md5_hex); warnings::warnif( 'deprecated', 'The CRAM-MD5 SASL mechanism is effectively deprecated by RFC8314 and should no longer be used' ); @ISA = qw(Authen::SASL::Perl); my %secflags = ( noplaintext => 1, noanonymous => 1, ); sub _order { 2 } sub _secflags { shift; scalar grep { $secflags{$_} } @_; } sub mechanism { 'CRAM-MD5' } sub client_start { ''; } sub client_step { my ($self, $string) = @_; my ($user, $pass) = map { my $v = $self->_call($_); defined($v) ? $v : '' } qw(user pass); $user . " " . hmac_md5_hex($string,$pass); } 1; __END__ =head1 NAME Authen::SASL::Perl::CRAM_MD5 - (DEPRECATED) CRAM MD5 Authentication class =head1 VERSION version 2.1900 =head1 SYNOPSIS use Authen::SASL qw(Perl); $sasl = Authen::SASL->new( mechanism => 'CRAM-MD5', callback => { user => $user, pass => $pass }, ); =head1 DESCRIPTION This method implements the client part of the CRAM-MD5 SASL algorithm, as described in RFC 2195 resp. in IETF Draft draft-ietf-sasl-crammd5-XX.txt. Please note that this mechanism has been moved to the "LIMITED" use section of the L and is effectively deprecated per L (see section 5; security considerations). =head2 CALLBACK The callbacks used are: =over 4 =item user The username to be used for authentication =item pass The user's password to be used for authentication =back =head1 SEE ALSO L, L =head1 AUTHORS Software written by Graham Barr , documentation written by Peter Marschall . Please report any bugs, or post any suggestions, to the perl-ldap mailing list =head1 COPYRIGHT Copyright (c) 2002-2004 Graham Barr. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Documentation Copyright (c) 2004 Peter Marschall. All rights reserved. This documentation is distributed, and may be redistributed, under the same terms as Perl itself. =cut EXTERNAL.pm100644001750001750 347515044402605 20150 0ustar00erikerik000000000000Authen-SASL-2.1900/lib/Authen/SASL/Perl# Copyright (c) 1998-2002 Graham Barr and 2001 Chris Ridd # . All rights reserved. This program # is free software; you can redistribute it and/or modify it under the # same terms as Perl itself. package Authen::SASL::Perl::EXTERNAL 2.1900; use strict; use warnings; use vars qw(@ISA); @ISA = qw(Authen::SASL::Perl); my %secflags = ( noplaintext => 1, nodictionary => 1, noanonymous => 1, ); sub _order { 2 } sub _secflags { shift; grep { $secflags{$_} } @_; } sub mechanism { 'EXTERNAL' } sub client_start { my $self = shift; my $v = $self->_call('user'); defined($v) ? $v : '' } #sub client_step { # shift->_call('user'); #} 1; __END__ =head1 NAME Authen::SASL::Perl::EXTERNAL - External Authentication class =head1 VERSION version 2.1900 =head1 SYNOPSIS use Authen::SASL qw(Perl); $sasl = Authen::SASL->new( mechanism => 'EXTERNAL', callback => { user => $user }, ); =head1 DESCRIPTION This method implements the client part of the EXTERNAL SASL algorithm, as described in RFC 2222. =head2 CALLBACK The callbacks used are: =over 4 =item user The username to be used for authentication =back =head1 SEE ALSO L, L =head1 AUTHORS Software written by Graham Barr , documentation written by Peter Marschall . Please report any bugs, or post any suggestions, to the perl-ldap mailing list =head1 COPYRIGHT Copyright (c) 1998-2004 Graham Barr. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Documentation Copyright (c) 2004 Peter Marschall. All rights reserved. This documentation is distributed, and may be redistributed, under the same terms as Perl itself. =cut ANONYMOUS.pm100644001750001750 343615044402605 20313 0ustar00erikerik000000000000Authen-SASL-2.1900/lib/Authen/SASL/Perl# Copyright (c) 2002 Graham Barr . All rights reserved. # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. package Authen::SASL::Perl::ANONYMOUS 2.1900; use strict; use warnings; use vars qw(@ISA); @ISA = qw(Authen::SASL::Perl); my %secflags = ( noplaintext => 1, ); sub _order { 0 } sub _secflags { shift; grep { $secflags{$_} } @_; } sub mechanism { 'ANONYMOUS' } sub client_start { shift->_call('authname') } sub client_step { shift->_call('authname') } 1; __END__ =head1 NAME Authen::SASL::Perl::ANONYMOUS - Anonymous Authentication class =head1 VERSION version 2.1900 =head1 SYNOPSIS use Authen::SASL qw(Perl); $sasl = Authen::SASL->new( mechanism => 'ANONYMOUS', callback => { authname => $mailaddress }, ); =head1 DESCRIPTION This method implements the client part of the ANONYMOUS SASL algorithm, as described in RFC 2245 resp. in IETF Draft draft-ietf-sasl-anon-XX.txt. =head2 CALLBACK The callbacks used are: =over 4 =item authname email address or UTF-8 encoded string to be used as trace information for the server =back =head1 SEE ALSO L, L =head1 AUTHORS Software written by Graham Barr , documentation written by Peter Marschall . Please report any bugs, or post any suggestions, to the perl-ldap mailing list =head1 COPYRIGHT Copyright (c) 2002-2004 Graham Barr. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Documentation Copyright (c) 2004 Peter Marschall. All rights reserved. This documentation is distributed, and may be redistributed, under the same terms as Perl itself. =cut DIGEST_MD5.pm100644001750001750 5641115044402605 20370 0ustar00erikerik000000000000Authen-SASL-2.1900/lib/Authen/SASL/Perl# Copyright (c) 2003-2009 Graham Barr, Djamel Boudjerda, Paul Connolly, Julian # Onions, Nexor and Yann Kerherve. # All rights reserved. This program is free software; you can redistribute # it and/or modify it under the same terms as Perl itself. # See http://www.ietf.org/rfc/rfc2831.txt for details package Authen::SASL::Perl::DIGEST_MD5 2.1900; use strict; use warnings; use vars qw(@ISA $CNONCE $NONCE); use Crypt::URandom qw(urandom); use Digest::MD5 qw(md5_hex md5); use Digest::HMAC_MD5 qw(hmac_md5); warnings::warnif( 'deprecated', 'The DIGEST-MD5 SASL mechanism is deprecated by RFC6331 and should no longer be used' ); # TODO: complete qop support in server, should be configurable @ISA = qw(Authen::SASL::Perl); my %secflags = ( noplaintext => 1, noanonymous => 1, ); # some have to be quoted - some don't - sigh! my (%cqdval, %sqdval); @cqdval{qw( username authzid realm nonce cnonce digest-uri )} = (); ## ...and server behaves different than client - double sigh! @sqdval{keys %cqdval, qw(qop cipher)} = (); # username authzid realm nonce cnonce digest-uri qop cipher #)} = (); my %multi; @{$multi{server}}{qw(realm auth-param)} = (); @{$multi{client}}{qw()} = (); my @server_required = qw(algorithm nonce); my @client_required = qw(username nonce cnonce nc qop response); # available ciphers my @ourciphers = ( { name => 'rc4', ssf => 128, bs => 1, ks => 16, pkg => 'Crypt::RC4', key => sub { $_[0] }, iv => sub {}, fixup => sub { # retrofit the Crypt::RC4 module with standard subs *Crypt::RC4::encrypt = *Crypt::RC4::decrypt = sub { goto &Crypt::RC4::RC4; }; *Crypt::RC4::keysize = sub {128}; *Crypt::RC4::blocksize = sub {1}; } }, { name => '3des', ssf => 112, bs => 8, ks => 16, pkg => 'Crypt::DES3', key => sub { pack('B8' x 16, map { $_ . '0' } map { unpack('a7' x 16, $_); } unpack('B*', substr($_[0], 0, 14)) ); }, iv => sub { substr($_[0], -8, 8) }, }, { name => 'des', ssf => 56, bs => 8, ks => 16, pkg => 'Crypt::DES', key => sub { pack('B8' x 8, map { $_ . '0' } map { unpack('a7' x 8, $_); } unpack('B*',substr($_[0], 0, 7)) ); }, iv => sub { substr($_[0], -8, 8) }, }, { name => 'rc4-56', ssf => 56, bs => 1, ks => 7, pkg => 'Crypt::RC4', key => sub { $_[0] }, iv => sub {}, fixup => sub { *Crypt::RC4::encrypt = *Crypt::RC4::decrypt = sub { goto &Crypt::RC4::RC4; }; *Crypt::RC4::keysize = sub {56}; *Crypt::RC4::blocksize = sub {1}; } }, { name => 'rc4-40', ssf => 40, bs => 1, ks => 5, pkg => 'Crypt::RC4', key => sub { $_[0] }, iv => sub {}, fixup => sub { *Crypt::RC4::encrypt = *Crypt::RC4::decrypt = sub { goto &Crypt::RC4::RC4; }; *Crypt::RC4::keysize = sub {40}; *Crypt::RC4::blocksize = sub {1}; } }, ); ## The system we are on, might not be able to crypt the stream our $NO_CRYPT_AVAILABLE = 1; for (@ourciphers) { eval "require $_->{pkg}"; unless ($@) { $NO_CRYPT_AVAILABLE = 0; last; } } sub _order { 3 } sub _secflags { shift; scalar grep { $secflags{$_} } @_; } sub mechanism { 'DIGEST-MD5' } sub _init { my ($pkg, $self) = @_; bless $self, $pkg; # set default security properties $self->property('minssf', 0); $self->property('maxssf', int 2**31 - 1); # XXX - arbitrary "high" value $self->property('maxbuf', 0xFFFFFF); # maximum supported by GSSAPI mech $self->property('externalssf', 0); $self; } sub _init_server { my $server = shift; my $options = shift || {}; if (!ref $options or ref $options ne 'HASH') { warn "options for DIGEST_MD5 should be a hashref"; $options = {}; } ## new server, means new nonce_counts $server->{nonce_counts} = {}; ## determine supported qop my @qop = ('auth'); push @qop, 'auth-int' unless $options->{no_integrity}; push @qop, 'auth-conf' unless $options->{no_integrity} or $options->{no_confidentiality} or $NO_CRYPT_AVAILABLE; $server->{supported_qop} = { map { $_ => 1 } @qop }; } sub init_sec_layer { my $self = shift; $self->{cipher} = undef; $self->{khc} = undef; $self->{khs} = undef; $self->{sndseqnum} = 0; $self->{rcvseqnum} = 0; # reset properties for new session $self->property(maxout => undef); $self->property(ssf => undef); } # no initial value passed to the server sub client_start { my $self = shift; $self->{need_step} = 1; $self->{error} = undef; $self->{state} = 0; $self->init_sec_layer; ''; } sub server_start { my $self = shift; my $challenge = shift; my $cb = shift || sub {}; $self->{need_step} = 1; $self->{error} = undef; $self->{nonce} = $NONCE ? md5_hex($NONCE) : unpack('H32',urandom(16)); $self->init_sec_layer; my $qop = [ sort keys %{$self->{supported_qop}} ]; ## get the realm using callbacks but default to the host specified ## during the instantiation of the SASL object my $realm = $self->_call('realm'); $realm ||= $self->host; my %response = ( nonce => $self->{nonce}, charset => 'utf-8', algorithm => 'md5-sess', realm => $realm, maxbuf => $self->property('maxbuf'), ## IN DRAFT ONLY: # If this directive is present multiple times the client MUST treat # it as if it received a single qop directive containing a comma # separated value from all instances. I.e., # 'qop="auth",qop="auth-int"' is the same as 'qop="auth,auth-int" 'qop' => $qop, 'cipher' => [ map { $_->{name} } @ourciphers ], ); my $final_response = _response(\%response); $cb->($final_response); return; } sub client_step { # $self, $server_sasl_credentials my ($self, $challenge) = @_; $self->{server_params} = \my %sparams; # Parse response parameters $self->_parse_challenge(\$challenge, server => $self->{server_params}) or return $self->set_error("Bad challenge: '$challenge'"); if ($self->{state} == 1) { # check server's `rspauth' response return $self->set_error("Server did not send rspauth in step 2") unless ($sparams{rspauth}); return $self->set_error("Invalid rspauth in step 2") unless ($self->{rspauth} eq $sparams{rspauth}); # all is well $self->set_success; return ''; } # check required fields in server challenge if (my @missing = grep { !exists $sparams{$_} } @server_required) { return $self->set_error("Server did not provide required field(s): @missing") } my %response = ( nonce => $sparams{'nonce'}, cnonce => $CNONCE ? md5_hex($CNONCE) : unpack('H32',urandom(16)), 'digest-uri' => $self->service . '/' . $self->host, # calc how often the server nonce has been seen; server expects "00000001" nc => sprintf("%08d", ++$self->{nonce_counts}{$sparams{'nonce'}}), charset => $sparams{'charset'}, ); return $self->set_error("Server qop too weak (qop = $sparams{'qop'})") unless ($self->_client_layer(\%sparams,\%response)); # let caller-provided fields override defaults: authorization ID, service name, realm my $s_realm = $sparams{realm} || []; my $realm = $self->_call('realm', @$s_realm); unless (defined $realm) { # If the user does not pick a realm, use the first from the server $realm = $s_realm->[0]; } if (defined $realm) { $response{realm} = $realm; } my $authzid = $self->_call('authname'); if (defined $authzid) { $response{authzid} = $authzid; } my $serv_name = $self->_call('serv'); if (defined $serv_name) { $response{'digest-uri'} .= '/' . $serv_name; } my $user = $self->_call('user'); return $self->set_error("Username is required") unless defined $user; $response{username} = $user; my $password = $self->_call('pass'); return $self->set_error("Password is required") unless defined $password; $self->property('maxout', $sparams{maxbuf} || 65536); # Generate the response value $self->{state} = 1; my ($response, $rspauth) = $self->_compute_digests_and_set_keys($password, \%response); $response{response} = $response; $self->{rspauth} = $rspauth; # finally, return our response token return _response(\%response, "is_client"); } sub _compute_digests_and_set_keys { my $self = shift; my $password = shift; my $params = shift; if (defined $params->{realm} and ref $params->{realm} eq 'ARRAY') { $params->{realm} = $params->{realm}[0]; } my $realm = $params->{realm}; $realm = "" unless defined $realm; my $A1 = join (":", md5(join (":", $params->{username}, $realm, $password)), @$params{defined($params->{authzid}) ? qw(nonce cnonce authzid) : qw(nonce cnonce) } ); # pre-compute MD5(A1) and HEX(MD5(A1)); these are used multiple times below my $hdA1 = unpack("H*", (my $dA1 = md5($A1)) ); # derive keys for layer encryption / integrity $self->{kic} = md5($dA1, 'Digest session key to client-to-server signing key magic constant'); $self->{kis} = md5($dA1, 'Digest session key to server-to-client signing key magic constant'); if (my $cipher = $self->{cipher}) { &{ $cipher->{fixup} || sub{} }; # compute keys for encryption my $ks = $cipher->{ks}; $self->{kcc} = md5(substr($dA1,0,$ks), 'Digest H(A1) to client-to-server sealing key magic constant'); $self->{kcs} = md5(substr($dA1,0,$ks), 'Digest H(A1) to server-to-client sealing key magic constant'); # get an encryption and decryption handle for the chosen cipher $self->{khc} = $cipher->{pkg}->new($cipher->{key}->($self->{kcc})); $self->{khs} = $cipher->{pkg}->new($cipher->{key}->($self->{kcs})); # initialize IVs $self->{ivc} = $cipher->{iv}->($self->{kcc}); $self->{ivs} = $cipher->{iv}->($self->{kcs}); } my $A2 = "AUTHENTICATE:" . $params->{'digest-uri'}; $A2 .= ":00000000000000000000000000000000" if ($params->{qop} ne 'auth'); my $response = md5_hex( join (":", $hdA1, @$params{qw(nonce nc cnonce qop)}, md5_hex($A2)) ); # calculate server `rspauth' response, so we can check in step 2 # the only difference here is in the A2 string which from which # `AUTHENTICATE' is omitted in the calculation of `rspauth' $A2 = ":" . $params->{'digest-uri'}; $A2 .= ":00000000000000000000000000000000" if ($params->{qop} ne 'auth'); my $rspauth = md5_hex( join (":", $hdA1, @$params{qw(nonce nc cnonce qop)}, md5_hex($A2)) ); return ($response, $rspauth); } sub server_step { my $self = shift; my $challenge = shift; my $cb = shift || sub {}; $self->{client_params} = \my %cparams; unless ( $self->_parse_challenge(\$challenge, client => $self->{client_params}) ) { $self->set_error("Bad challenge: '$challenge'"); return $cb->(); } # check required fields in server challenge if (my @missing = grep { !exists $cparams{$_} } @client_required) { $self->set_error("Client did not provide required field(s): @missing"); return $cb->(); } my $count = hex ($cparams{'nc'} || 0); unless ($count == ++$self->{nonce_counts}{$cparams{nonce}}) { $self->set_error("nonce-count doesn't match: $count"); return $cb->(); } my $qop = $cparams{'qop'} || "auth"; unless ($self->is_qop_supported($qop)) { $self->set_error("Client qop not supported (qop = '$qop')"); return $cb->(); } my $username = $cparams{'username'}; unless ($username) { $self->set_error("Client didn't provide a username"); return $cb->(); } # "The authzid MUST NOT be an empty string." if (exists $cparams{authzid} && $cparams{authzid} eq '') { $self->set_error("authzid cannot be empty"); return $cb->(); } my $authzid = $cparams{authzid}; # digest-uri: "Servers SHOULD check that the supplied value is correct. # This will detect accidental connection to the incorrect server, as well as # some redirection attacks" my $digest_uri = $cparams{'digest-uri'}; my ($cservice, $chost, $cservname) = split '/', $digest_uri, 3; if ($cservice ne $self->service or $chost ne $self->host) { # XXX deal with serv_name $self->set_error("Incorrect digest-uri"); return $cb->(); } unless (defined $self->callback('getsecret')) { $self->set_error("a getsecret callback MUST be defined"); $cb->(); return; } my $realm = $self->{client_params}->{'realm'}; my $response_check = sub { my $password = shift; return $self->set_error("Cannot get the passord for $username") unless defined $password; ## configure the security layer $self->_server_layer($qop) or return $self->set_error("Cannot negociate the security layer"); my ($expected, $rspauth) = $self->_compute_digests_and_set_keys($password, $self->{client_params}); return $self->set_error("Incorrect response $self->{client_params}->{response} <> $expected") unless $expected eq $self->{client_params}->{response}; my %response = ( rspauth => $rspauth, ); # I'm not entirely sure of what I am doing $self->{answer}{$_} = $self->{client_params}->{$_} for qw/username authzid realm serv/; $self->set_success; return _response(\%response); }; $self->callback('getsecret')->( $self, { user => $username, realm => $realm, authzid => $authzid }, sub { $cb->( $response_check->( shift ) ) }, ); } sub is_qop_supported { my $self = shift; my $qop = shift; return $self->{supported_qop}{$qop}; } sub _response { my $response = shift; my $is_client = shift; my @out; for my $k (sort keys %$response) { my $is_array = ref $response->{$k} && ref $response->{$k} eq 'ARRAY'; my @values = $is_array ? @{$response->{$k}} : ($response->{$k}); # Per spec, one way of doing it: multiple k=v #push @out, [$k, $_] for @values; # other way: comma separated list push @out, [$k, join (',', @values)]; } return join (",", map { _qdval($_->[0], $_->[1], $is_client) } @out); } sub _parse_challenge { my $self = shift; my $challenge_ref = shift; my $type = shift; my $params = shift; while($$challenge_ref =~ s/^(?:\s*,)*\s* # remaining or crap ([\w-]+) # key, eg: qop = ("([^\\"]+|\\.)*"|[^,]+) # value, eg: auth-conf or "NoNcE" \s*(?:,\s*)* # remaining //x) { my ($k, $v) = ($1,$2); if ($v =~ /^"(.*)"$/s) { ($v = $1) =~ s/\\(.)/$1/g; } if (exists $multi{$type}{$k}) { my $aref = $params->{$k} ||= []; push @$aref, $v; } elsif (defined $params->{$k}) { return $self->set_error("Bad challenge: '$$challenge_ref'"); } else { $params->{$k} = $v; } } return length $$challenge_ref ? 0 : 1; } sub _qdval { my ($k, $v, $is_client) = @_; my $qdval = $is_client ? \%cqdval : \%sqdval; if (!defined $v) { return; } elsif (exists $qdval->{$k}) { $v =~ s/([\\"])/\\$1/g; return qq{$k="$v"}; } return "$k=$v"; } sub _server_layer { my ($self, $auth) = @_; # XXX dupe # construct our qop mask my $maxssf = $self->property('maxssf') - $self->property('externalssf'); $maxssf = 0 if ($maxssf < 0); my $minssf = $self->property('minssf') - $self->property('externalssf'); $minssf = 0 if ($minssf < 0); return undef if ($maxssf < $minssf); # sanity check my $ciphers = [ map { $_->{name} } @ourciphers ]; if (( $auth eq 'auth-conf') and $self->_select_cipher($minssf, $maxssf, $ciphers )) { $self->property('ssf', $self->{cipher}->{ssf}); return 1; } if ($auth eq 'auth-int') { $self->property('ssf', 1); return 1; } if ($auth eq 'auth') { $self->property('ssf', 0); return 1; } return undef; } sub _client_layer { my ($self, $sparams, $response) = @_; # construct server qop mask # qop in server challenge is optional: if not there "auth" is assumed my $smask = 0; map { m/^auth$/ and $smask |= 1; m/^auth-int$/ and $smask |= 2; m/^auth-conf$/ and $smask |= 4; } split(/,/, $sparams->{qop}||'auth'); # XXX I think we might have a bug here bc. of LWS # construct our qop mask my $cmask = 0; my $maxssf = $self->property('maxssf') - $self->property('externalssf'); $maxssf = 0 if ($maxssf < 0); my $minssf = $self->property('minssf') - $self->property('externalssf'); $minssf = 0 if ($minssf < 0); return undef if ($maxssf < $minssf); # sanity check # ssf values > 1 mean integrity and confidentiality # ssf == 1 means integrity but no confidentiality # ssf < 1 means neither integrity nor confidentiality # no security layer can be had if buffer size is 0 $cmask |= 1 if ($minssf < 1); $cmask |= 2 if ($minssf <= 1 and $maxssf >= 1); $cmask |= 4 if ($maxssf > 1); # find common bits $cmask &= $smask; # parse server cipher options my @sciphers = split(/,/, $sparams->{'cipher-opts'}||$sparams->{cipher}||''); if (($cmask & 4) and $self->_select_cipher($minssf,$maxssf,\@sciphers)) { $response->{qop} = 'auth-conf'; $response->{cipher} = $self->{cipher}->{name}; $self->property('ssf', $self->{cipher}->{ssf}); return 1; } if ($cmask & 2) { $response->{qop} = 'auth-int'; $self->property('ssf', 1); return 1; } if ($cmask & 1) { $response->{qop} = 'auth'; $self->property('ssf', 0); return 1; } return undef; } sub _select_cipher { my ($self, $minssf, $maxssf, $ciphers) = @_; # compose a subset of candidate ciphers based on ssf and peer list my @a = map { my $c = $_; (grep { $c->{name} eq $_ } @$ciphers and $c->{ssf} >= $minssf and $c->{ssf} <= $maxssf) ? $_ : () } @ourciphers; # from these, select the first one we can create an instance of for (@a) { next unless eval "require $_->{pkg}"; $self->{cipher} = $_; return 1; } return 0; } use Digest::HMAC_MD5 qw(hmac_md5); sub encode { # input: self, plaintext buffer,length (length not used here) my $self = shift; my $seqnum = pack('N', $self->{sndseqnum}++); my $mac = substr(hmac_md5($seqnum . $_[0], $self->{kic}), 0, 10); # if integrity only, return concatenation of buffer, MAC, TYPE and SEQNUM return $_[0] . $mac.pack('n',1) . $seqnum unless ($self->{khc}); # must encrypt, block ciphers need padding bytes my $pad = ''; my $bs = $self->{cipher}->{bs}; if ($bs > 1) { # padding is added in between BUF and MAC my $n = $bs - ((length($_[0]) + 10) & ($bs - 1)); $pad = chr($n) x $n; } # XXX - for future AES cipher support, the currently used common _crypt() # function probably wont do; we might to switch to per-cipher routines # like so: # return $self->{khc}->encrypt($_[0] . $pad . $mac) . pack('n', 1) . $seqnum; return $self->_crypt(0, $_[0] . $pad . $mac) . pack('n', 1) . $seqnum; } sub decode { # input: self, cipher buffer,length my ($self, $buf, $len) = @_; return if ($len <= 16); # extract TYPE/SEQNUM from end of buffer my ($type,$seqnum) = unpack('na[4]', substr($buf, -6, 6, '')); # decrypt remaining buffer, if necessary if ($self->{khs}) { # XXX - see remark above in encode() #$buf = $self->{khs}->decrypt($buf); $buf = $self->_crypt(1, $buf); } return unless ($buf); # extract 10-byte MAC from the end of (decrypted) buffer my ($mac) = unpack('a[10]', substr($buf, -10, 10, '')); if ($self->{khs} and $self->{cipher}->{bs} > 1) { # remove padding my $n = ord(substr($buf, -1, 1)); substr($buf, -$n, $n, ''); } # check the MAC my $check = substr(hmac_md5($seqnum . $buf, $self->{kis}), 0, 10); return if ($mac ne $check); return if (unpack('N', $seqnum) != $self->{rcvseqnum}); $self->{rcvseqnum}++; return $buf; } sub _crypt { # input: op(decrypting=1/encrypting=0)), buffer my ($self,$d) = (shift,shift); my $bs = $self->{cipher}->{bs}; if ($bs <= 1) { # stream cipher return $d ? $self->{khs}->decrypt($_[0]) : $self->{khc}->encrypt($_[0]) } # the remainder of this sub is for block ciphers # get current IV my $piv = \$self->{$d ? 'ivs' : 'ivc'}; my $iv = $$piv; my $result = join '', map { my $x = $d ? $iv ^ $self->{khs}->decrypt($_) : $self->{khc}->encrypt($iv ^ $_); $iv = $d ? $_ : $x; $x; } unpack("a$bs "x(int(length($_[0])/$bs)), $_[0]); # store current IV $$piv = $iv; return $result; } 1; __END__ =head1 NAME Authen::SASL::Perl::DIGEST_MD5 - (DEPRECATED) Digest MD5 Authentication class =head1 VERSION version 2.1900 =head1 SYNOPSIS use Authen::SASL qw(Perl); $sasl = Authen::SASL->new( mechanism => 'DIGEST-MD5', callback => { user => $user, pass => $pass, serv => $serv }, ); =head1 DESCRIPTION This method implements the client and server parts of the DIGEST-MD5 SASL algorithm, as described in RFC 2831. Please note that this mechanism has been moved to the "OBSOLETE" section of the L as per L. =head2 CALLBACK The callbacks used are: =head3 client =over 4 =item authname The authorization id to use after successful authentication =item user The username to be used in the response =item pass The password to be used to compute the response. =item serv The service name when authenticating to a replicated service =item realm The authentication realm when overriding the server-provided default. If not given the server-provided value is used. The callback will be passed the list of realms that the server provided in the initial response. =back =head3 server =over 4 =item realm The default realm to provide to the client =item getsecret(username, realm, authzid) returns the password associated with C and C =back =head2 PROPERTIES The properties used are: =over 4 =item maxbuf The maximum buffer size for receiving cipher text =item minssf The minimum SSF value that should be provided by the SASL security layer. The default is 0 =item maxssf The maximum SSF value that should be provided by the SASL security layer. The default is 2**31 =item externalssf The SSF value provided by an underlying external security layer. The default is 0 =item ssf The actual SSF value provided by the SASL security layer after the SASL authentication phase has been completed. This value is read-only and set by the implementation after the SASL authentication phase has been completed. =item maxout The maximum plaintext buffer size for sending data to the peer. This value is set by the implementation after the SASL authentication phase has been completed and a SASL security layer is in effect. =back =head1 SEE ALSO L, L =head1 AUTHORS Graham Barr, Djamel Boudjerda (NEXOR), Paul Connolly, Julian Onions (NEXOR), Yann Kerherve. Please report any bugs, or post any suggestions, to the perl-ldap mailing list =head1 COPYRIGHT Copyright (c) 2003-2009 Graham Barr, Djamel Boudjerda, Paul Connolly, Julian Onions, Nexor, Peter Marschall and Yann Kerherve. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut OAUTHBEARER.pm100644001750001750 524215044402605 20461 0ustar00erikerik000000000000Authen-SASL-2.1900/lib/Authen/SASL/Perl# Copyright (c) 2025 Aditya Garg # Copyright (c) 2025 Julian Swagemakers # All rights reserved. # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. package Authen::SASL::Perl::OAUTHBEARER 2.1900; use strict; use vars qw(@ISA); use JSON::PP; @ISA = qw(Authen::SASL::Perl); my %secflags = ( noanonymous => 1, ); sub _order { 1 } sub _secflags { shift; scalar grep { $secflags{$_} } @_; } sub mechanism { 'OAUTHBEARER' } sub client_start { my $self = shift; $self->{stage} = 0; # This will generate the oauthbearer string used for authentication. # # "n,a=" {User} ",^Ahost=" {Host} "^Aport=" {Port} "^Aauth=Bearer " {Access Token} "^A^A # # The first part `n,a=" {User} ",` is the gs2 header described in RFC5801. # * gs2-cb-flag `n` -> client does not support CB # * gs2-authzid `a=" {User} "` # # The second part are key value pairs containing host, port and auth as # described in RFC7628. # # https://datatracker.ietf.org/doc/html/rfc5801 # https://datatracker.ietf.org/doc/html/rfc7628 my $username = $self->_call('user'); my $token = $self->_call('pass'); # OAuth 2.0 access token my $auth_string = "n,a=$username,\001auth=Bearer $token\001\001"; return $auth_string; } sub client_step { my ($self, $challenge) = @_; my $json = JSON::PP->new; my $payload = $json->decode( $challenge ); $self->set_error( $payload ); # Send dummy request on authentication failure according to rfc7628. # https://datatracker.ietf.org/doc/html/rfc7628#section-3.2.3 return "\001"; } 1; __END__ =head1 NAME Authen::SASL::Perl::OAUTHBEARER - OAUTHBEARER Authentication class =head1 VERSION version 2.1900 =head1 SYNOPSIS use Authen::SASL qw(Perl); $sasl = Authen::SASL->new( mechanism => 'OAUTHBEARER', callback => { user => $user, pass => $access_token }, ); =head1 DESCRIPTION This module implements the client side of the OAUTHBEARER SASL mechanism, which is used for OAuth 2.0-based authentication. =head2 CALLBACK The callbacks used are: =head3 Client =over 4 =item user The username to be used for authentication. =item pass The OAuth 2.0 access token to be used for authentication. =back =head1 SEE ALSO L, L =head1 AUTHORS Written by Aditya Garg and Julian Swagemakers. =head1 COPYRIGHT Copyright (c) 2025 Aditya Garg. Copyright (c) 2025 Julian Swagemakers. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut