[Bps-public-commit] rt-authen-externalauth branch, master, created. 03f633d0be7595ca49a321d28437c608f63e7fad
Kevin Falcone
falcone at bestpractical.com
Mon Apr 25 11:57:02 EDT 2011
The branch, master has been created
at 03f633d0be7595ca49a321d28437c608f63e7fad (commit)
- Log -----------------------------------------------------------------
commit 9b8e351fa4f9f7bb14118cef257b5467fd07ecaa
Author: Mike Peachey <zordrak at cpan.org>
Date: Thu Mar 13 11:16:36 2008 -0500
initial import of RT-Authen-ExternalAuth 0.01 from CPAN
git-cpan-module: RT-Authen-ExternalAuth
git-cpan-version: 0.01
git-cpan-authorid: ZORDRAK
git-cpan-file: authors/id/Z/ZO/ZORDRAK/RT-Authen-ExternalAuth-0.01.tar.gz
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..6401887
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,344 @@
+
+ GNU GENERAL PUBLIC LICENSE
+ Version 2, June 1991
+
+ Copyright (C) 1989, 1991 Free Software Foundation, Inc.
+ 51 Franklin Street, 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 licenses for most software are designed to take away your
+freedom to share and change it. By contrast, the GNU 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. This
+General Public License applies to most of the Free Software
+Foundation's software and to any other program whose authors commit to
+using it. (Some other Free Software Foundation software is covered by
+the GNU Library General Public License instead.) You can apply it to
+your programs, too.
+
+ When we speak of free software, we are referring to freedom, not
+price. Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+this service if you wish), 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 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 show them these terms so they know 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.
+
+ Finally, any free program is threatened constantly by software
+patents. We wish to avoid the danger that redistributors of a free
+program will individually obtain patent licenses, in effect making the
+program proprietary. To prevent this, we have made it clear that any
+patent must be licensed for everyone's free use or not licensed at all.
+
+ 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 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 derivative work under copyright law:
+that is to say, a work containing the Program or a portion of it,
+either verbatim or with modifications and/or translated into another
+language. (Hereinafter, translation is included without limitation in
+the term "modification".) Each licensee is addressed as "you".
+
+Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope. The act of
+running the Program is not restricted, and the output from the Program
+is covered only if its contents constitute a work based on the
+Program (independent of having been made by running the Program).
+Whether that is true depends on what the Program does.
+
+ 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 License and to the absence of any warranty;
+and give any other recipients of the Program a copy of this License
+along with the Program.
+
+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.
+
+ 2. You may modify your copy or copies of the Program or any portion
+of it, thus forming a work based on the Program, and copy and
+distribute such modifications or work under the terms of Section 1
+above, provided that you also meet all of these conditions:
+
+ a) You must cause the modified files to carry prominent notices
+ stating that you changed the files and the date of any change.
+
+ b) You must cause any work that you distribute or publish, that in
+ whole or in part contains or is derived from the Program or any
+ part thereof, to be licensed as a whole at no charge to all third
+ parties under the terms of this License.
+
+ c) If the modified program normally reads commands interactively
+ when run, you must cause it, when started running for such
+ interactive use in the most ordinary 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
+ License. (Exception: if the Program itself is interactive but
+ does not normally print such an announcement, your work based on
+ the Program is not required to print an announcement.)
+
+These requirements apply to the modified work as a whole. If
+identifiable sections of that work are not derived from the Program,
+and can be reasonably considered independent and separate works in
+themselves, then this License, and its terms, do not apply to those
+sections when you distribute them as separate works. But when you
+distribute the same sections as part of a whole which is a work based
+on the Program, the distribution of the whole must be on the terms of
+this License, whose permissions for other licensees extend to the
+entire whole, and thus to each and every part regardless of who wrote it.
+
+Thus, it is not the intent of this section to claim rights or contest
+your rights to work written entirely by you; rather, the intent is to
+exercise the right to control the distribution of derivative or
+collective works based on the Program.
+
+In addition, mere aggregation of another work not based on the Program
+with the Program (or with a work based on the Program) on a volume of
+a storage or distribution medium does not bring the other work under
+the scope of this License.
+
+ 3. You may copy and distribute the Program (or a work based on it,
+under Section 2) in object code or executable form under the terms of
+Sections 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 Sections
+ 1 and 2 above on a medium customarily used for software
+ interchange; or,
+
+ b) Accompany it with a written offer, valid for at least three
+ years, to give any third party, for a charge no more than your
+ cost of physically performing source distribution, a complete
+ machine-readable copy of the corresponding source code, to be
+ distributed under the terms of Sections 1 and 2 above on a medium
+ customarily used for software interchange; or,
+
+ c) Accompany it with the information you received as to the offer
+ to distribute corresponding source code. (This alternative is
+ allowed only for noncommercial distribution and only if you
+ received the program in object code or executable form with such
+ an offer, in accord with Subsection b above.)
+
+The source code for a work means the preferred form of the work for
+making modifications to it. For an executable work, complete source
+code means all the source code for all modules it contains, plus any
+associated interface definition files, plus the scripts used to
+control compilation and installation of the executable. However, as a
+special exception, the source code distributed need not include
+anything that is normally distributed (in either source or binary
+form) with the major components (compiler, kernel, and so on) of the
+operating system on which the executable runs, unless that component
+itself accompanies the executable.
+
+If distribution of executable or object code is made by offering
+access to copy from a designated place, then offering equivalent
+access to copy the source code from the same place counts as
+distribution of the source code, even though third parties are not
+compelled to copy the source along with the object code.
+
+ 4. You may not copy, modify, sublicense, or distribute the Program
+except as expressly provided under this License. Any attempt
+otherwise to copy, modify, sublicense or distribute the Program is
+void, and will automatically terminate your rights under this License.
+However, parties who have received copies, or rights, from you under
+this License will not have their licenses terminated so long as such
+parties remain in full compliance.
+
+ 5. You are not required to accept this License, since you have not
+signed it. However, nothing else grants you permission to modify or
+distribute the Program or its derivative works. These actions are
+prohibited by law if you do not accept this License. Therefore, by
+modifying or distributing 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 for copying, distributing or modifying
+the Program or works based on it.
+
+ 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.
+You are not responsible for enforcing compliance by third parties to
+this License.
+
+ 7. If, as a consequence of a court judgment or allegation of patent
+infringement or for any other reason (not limited to patent issues),
+conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License. If you cannot
+distribute so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you
+may not distribute the Program at all. For example, if a patent
+license would not permit royalty-free redistribution of the Program by
+all those who receive copies directly or indirectly through you, then
+the only way you could satisfy both it and this License would be to
+refrain entirely from distribution of the Program.
+
+If any portion of this section is held invalid or unenforceable under
+any particular circumstance, the balance of the section is intended to
+apply and the section as a whole is intended to apply in other
+circumstances.
+
+It is not the purpose of this section to induce you to infringe any
+patents or other property right claims or to contest validity of any
+such claims; this section has the sole purpose of protecting the
+integrity of the free software distribution system, which is
+implemented by public license practices. Many people have made
+generous contributions to the wide range of software distributed
+through that system in reliance on consistent application of that
+system; it is up to the author/donor to decide if he or she is willing
+to distribute software through any other system and a licensee cannot
+impose that choice.
+
+This section is intended to make thoroughly clear what is believed to
+be a consequence of the rest of this License.
+
+ 8. If the distribution and/or use of the Program is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Program under this License
+may add an explicit geographical distribution limitation excluding
+those countries, so that distribution is permitted only in or among
+countries not thus excluded. In such case, this License incorporates
+the limitation as if written in the body of this License.
+
+ 9. 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 this 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 this License, you may choose any version ever
+published by the Free Software Foundation.
+
+ 10. 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
+
+ 11. 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.
+
+ 12. 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
+
+ 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 the public, 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.
+
+ <one line to give the program's name and a brief idea of what it does.>
+ Copyright (C) <year> <name of author>
+
+ 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 2 of the License, 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) year 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 is a sample; alter the names:
+
+ Yoyodyne, Inc., hereby disclaims all copyright interest in the program
+ `Gnomovision' (which makes passes at compilers) written by James Hacker.
+
+ <signature of Ty Coon>, 1 April 1989
+ Ty Coon, President of Vice
+
+This General Public License does not permit incorporating your program into
+proprietary programs. If your program is a subroutine library, you may
+consider it more useful to permit linking proprietary applications with the
+library. If this is what you want to do, use the GNU Library General
+Public License instead of this License.
diff --git a/MANIFEST b/MANIFEST
new file mode 100644
index 0000000..5df033d
--- /dev/null
+++ b/MANIFEST
@@ -0,0 +1,18 @@
+etc/RT_SiteConfig.pm
+html/Callbacks/ExternalAuth/autohandler/Auth
+inc/Module/Install.pm
+inc/Module/Install/Base.pm
+inc/Module/Install/Can.pm
+inc/Module/Install/Fetch.pm
+inc/Module/Install/Makefile.pm
+inc/Module/Install/Metadata.pm
+inc/Module/Install/RTx.pm
+inc/Module/Install/Win32.pm
+inc/Module/Install/WriteAll.pm
+lib/RT/Authen/ExternalAuth.pm
+lib/RT/User_Vendor.pm
+LICENSE
+Makefile.PL
+MANIFEST This list of files
+META.yml
+README
diff --git a/META.yml b/META.yml
new file mode 100644
index 0000000..25e1d3a
--- /dev/null
+++ b/META.yml
@@ -0,0 +1,20 @@
+---
+abstract: RT Authen-ExternalAuth Extension
+author:
+ - 'Mike Peachey <zordrak at cpan.org>'
+distribution_type: module
+generated_by: Module::Install version 0.68
+license: GPL version 2
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.3.html
+ version: 1.3
+name: RT-Authen-ExternalAuth
+no_index:
+ directory:
+ - etc
+ - html
+ - inc
+ - t
+requires:
+ RT: 0
+version: 0.01
diff --git a/Makefile.PL b/Makefile.PL
new file mode 100755
index 0000000..91f0596
--- /dev/null
+++ b/Makefile.PL
@@ -0,0 +1,12 @@
+use inc::Module::Install;
+
+RTx('RT-Authen-ExternalAuth');
+
+license('GPL version 2');
+author('Mike Peachey <zordrak at cpan.org>');
+
+all_from('lib/RT/Authen/ExternalAuth.pm');
+
+requires('RT');
+
+&WriteAll;
diff --git a/README b/README
new file mode 100644
index 0000000..be2d917
--- /dev/null
+++ b/README
@@ -0,0 +1,55 @@
+RT-Authen-ExternalAuth
+
+This module provides the ability to authenticate RT users
+against one or more external data sources at once. It will
+also allow information about that user to be loaded from
+the same, or any other available, source.
+
+The extension currently supports authentication and
+information from LDAP via the Net::LDAP module, and from
+any data source that an installed DBI driver is available
+for.
+
+It was originally designed and tested against:
+
+MySQL v4.1.21-standard
+MySQL v5.0.22
+Windows Active Directory v2003
+
+But it has been designed so that it should work with ANY
+LDAP service and ANY DBI-drivable database, based upon the
+configuration given in your $RTHOME/etc/RT_SiteConfig.pm
+
+INSTALLATION
+
+To install this module, run the following commands:
+
+ perl Makefile.PL
+ make
+ make install
+
+Once installed, you should view the file:
+
+ $RTHOME/local/etc/ExternalAuth/RT_SiteConfig.pm
+
+Then use the examples provided to prepare your own custom
+configuration which should reside in
+$RTHOME/etc/RT_SiteConfig.pm
+
+Alternatively, you may alter the provided examples directly
+and then include the extra directives by including the
+example file's path at the end of your RT_SiteConfig.pm
+
+AUTHOR
+ Mike Peachey
+ Jennic Ltd.
+ zordrak at cpan.org
+
+COPYRIGHT AND LICENCE
+
+Copyright (C) 2008, Jennic Ltd.
+
+This software is released under version 2 of the GNU
+General Public License. The license is distributed with
+this package in the LICENSE file found in the directory
+root.
diff --git a/etc/RT_SiteConfig.pm b/etc/RT_SiteConfig.pm
new file mode 100644
index 0000000..6e8d766
--- /dev/null
+++ b/etc/RT_SiteConfig.pm
@@ -0,0 +1,141 @@
+# The order in which the services defined in ExternalSettings
+# should be used to authenticate users. User is authenticated
+# if successfully confirmed by any service - no more services
+# are checked.
+Set($ExternalAuthPriority, [ 'My_LDAP',
+ 'My_MySQL'
+ ]
+);
+
+# The order in which the services defined in ExternalSettings
+# should be used to get information about users. This includes
+# RealName, Tel numbers etc, but also whether or not the user
+# should be considered disabled.
+# Once user info is found, no more services are checked.
+Set($ExternalInfoPriority, [ 'My_MySQL',
+ 'My_LDAP'
+ ]
+);
+
+# If this is set to true, then the relevant packages will
+# be loaded to use SSL/TLS connections. At the moment,
+# this just means "use Net::SSLeay;"
+Set($ExternalServiceUsesSSLorTLS, 0);
+
+# If this is set to 1, then users should be autocreated by RT
+# as internal users if they fail to authenticate from an
+# external service.
+Set($AutoCreateNonExternalUsers, 0);
+
+# These are the full settings for each external service as a HashOfHashes
+# Note that you may have as many external services as you wish. They will
+# be checked in the order specified in the Priority directives above.
+# e.g.
+# Set(ExternalAuthPriority,['My_LDAP','My_MySQL','My_Oracle','SecondaryLDAP','Other-DB']);
+#
+Set($ExternalSettings, { # AN EXAMPLE DB SERVICE
+ 'My_MySQL' => { ## GENERIC SECTION
+ # The type of service (db/ldap)
+ 'type' => 'db',
+ # Should the service be used for authentication?
+ 'auth' => 1,
+ # Should the service be used for information?
+ 'info' => 1,
+ # The server hosting the service
+ 'server' => 'server.domain.tld',
+ ## SERVICE-SPECIFIC SECTION
+ # The database name
+ 'database' => 'DB_NAME',
+ # The database table
+ 'table' => 'USERS_TABLE',
+ # The user to connect to the database as
+ 'user' => 'DB_USER',
+ # The password to use to connect with
+ 'pass' => 'DB_PASS',
+ # The port to use to connect with (e.g. 3306)
+ 'port' => 'DB_PORT',
+ # The name of the Perl DBI driver to use (e.g. mysql)
+ 'dbi_driver' => 'DBI_DRIVER',
+ # The field in the table that holds usernames
+ 'u_field' => 'username',
+ # The field in the table that holds passwords
+ 'p_field' => 'password',
+ # The Perl package & subroutine used to encrypt passwords
+ # e.g. if the passwords are stored using the MySQL v3.23 "PASSWORD"
+ # function, then you will need Crypt::MySQL::password, but for the
+ # MySQL4+ password function you will need Crypt::MySQL::password41
+ # Alternatively, you could use Crypt::MD5::md5_hex or any other
+ # encryption subroutine you can load in your perl installation
+ 'p_enc_pkg' => 'Crypt::MySQL',
+ 'p_enc_sub' => 'password',
+ # The field and values in the table that determines if a user should
+ # be disabled. For example, if the field is 'user_status' and the values
+ # are ['0','1','2','disabled'] then the user will be disabled if their
+ # user_status is set to '0','1','2' or the string 'disabled'.
+ # Otherwise, they will be considered enabled.
+ 'd_field' => 'userSupportAccess',
+ 'd_values' => ['0'],
+ ## RT ATTRIBUTE MATCHING SECTION
+ # The list of RT attributes that uniquely identify a user
+ 'attr_match_list' => [ 'Gecos',
+ 'Name'
+ ],
+ # The mapping of RT attributes on to field names
+ 'attr_map' => { 'Name' => 'username',
+ 'EmailAddress' => 'email',
+ 'ExternalAuthId' => 'username',
+ 'Gecos' => 'userID'
+ }
+ },
+ # AN EXAMPLE LDAP SERVICE
+ 'My_LDAP' => { ## GENERIC SECTION
+ # The type of service (db/ldap/cookie)
+ 'type' => 'ldap',
+ # Should the service be used for authentication?
+ 'auth' => 1,
+ # Should the service be used for information?
+ 'info' => 1,
+ # The server hosting the service
+ 'server' => 'server.domain.tld',
+ ## SERVICE-SPECIFIC SECTION
+ # The LDAP search base
+ 'base' => 'ou=Organisational Unit,dc=domain,dc=TLD',
+ # The filter to use to match RT-Users
+ 'filter' => '(FILTER_STRING)',
+ # The filter that will only match disabled users
+ 'd_filter' => '(FILTER_STRING)',
+ # Should we try to use TLS to encrypt connections?
+ 'tls' => 0,
+ # What other args should I pass to Net::LDAP->new($host, at args)?
+ 'net_ldap_args' => [ version => 3 ],
+ # Does authentication depend on group membership? What group name?
+ 'group' => 'GROUP_NAME',
+ # What is the attribute for the group object that determines membership?
+ 'group_attr' => 'GROUP_ATTR',
+ ## RT ATTRIBUTE MATCHING SECTION
+ # The list of RT attributes that uniquely identify a user
+ 'attr_match_list' => [ 'Name',
+ 'EmailAddress',
+ 'RealName',
+ 'WorkPhone',
+ 'Address2'
+ ],
+ # The mapping of RT attributes on to LDAP attributes
+ 'attr_map' => { 'Name' => 'sAMAccountName',
+ 'EmailAddress' => 'mail',
+ 'Organization' => 'physicalDeliveryOfficeName',
+ 'RealName' => 'cn',
+ 'ExternalAuthId' => 'sAMAccountName',
+ 'Gecos' => 'sAMAccountName',
+ 'WorkPhone' => 'telephoneNumber',
+ 'Address1' => 'streetAddress',
+ 'City' => 'l',
+ 'State' => 'st',
+ 'Zip' => 'postalCode',
+ 'Country' => 'co'
+ }
+ }
+ }
+);
+
+1;
diff --git a/html/Callbacks/ExternalAuth/autohandler/Auth b/html/Callbacks/ExternalAuth/autohandler/Auth
new file mode 100644
index 0000000..6076766
--- /dev/null
+++ b/html/Callbacks/ExternalAuth/autohandler/Auth
@@ -0,0 +1,109 @@
+<%init>
+
+# If the user is logging in, let's authenticate; if they can auth but don't load
+# (e.g. they don't have an account but external auth succeeds), we'll autocreate
+# their account.
+unless ($session{'CurrentUser'}) {
+
+ # Password has not been confirmed valid until we say so
+ my $password_validated;
+ # User has only been autocreated if we say so later on
+ # This is used to stop a pointless LookupExternalUserInfo
+ # called by LookupFromExternal later on since it's already
+ # called by RT::User::Create if the user was autocreated
+ my $user_autocreated = 0;
+
+ # If $user has been passed by login page,
+ # or any other custom code previous to this
+ if (defined ($user)) {
+ $session{'CurrentUser'} = RT::CurrentUser->new();
+ $session{'CurrentUser'}->Load($user);
+
+ # Unless we have loaded a valid user with a UserID
+ unless ($session{'CurrentUser'}->Id) {
+ # Start with a new SystemUser
+ my $UserObj = RT::User->new($RT::SystemUser);
+ # Set the user's name to the one we were given
+ my ($val, $msg) = $UserObj->SetName($user);
+
+ # If a password was given on the login page, validate it
+ if (defined($pass)) {
+ $password_validated = $UserObj->IsPassword($pass);
+ }
+
+ # If the password was validated successfully
+ # start the autocreation process to create the user
+ # permanently in RT
+ if ($password_validated) {
+ ### If there were a standard param to check for whether or not we
+ ### should autocreate authenticated users, we'd check it here.
+ my ($val, $msg) =
+ $UserObj->Create(%{ref($RT::AutoCreate) ? $RT::AutoCreate : {}},
+ Name => $user,
+ Gecos => $user,
+ );
+ $RT::Logger->info( "Autocreated authenticated user",
+ $UserObj->Name,
+ "(",
+ $UserObj->Id,
+ ")");
+ $user_autocreated = 1;
+ }
+
+ # If we autocreated a user, then load the user as the CurrentUser in $session
+ # To RT, this means we have a valid, authenticated user
+ $session{'CurrentUser'}->Load($user) if $UserObj->Id;
+ }
+ }
+
+ # If we now have a completely valid RT user to play with...
+ if ($session{'CurrentUser'} && $session{'CurrentUser'}->Id) {
+ unless($user_autocreated){
+ # If we definitely have an authenticated user and all is well,
+ # and we haven't JUST created the user, then update their
+ # information from external services before doing anything else
+ $session{'CurrentUser'}->UserObj->UpdateFromExternal();
+ }
+
+ # Now that we definitely have up-to-date user information,
+ # if the user is disabled, kick them out. Now!
+ if ($session{'CurrentUser'}->UserObj->Disabled) {
+ delete $session{'CurrentUser'};
+ }
+ }
+ # Original thank to Walter Duncan for these session deletes.
+
+ # If the user has already been authenticated successfully above
+ # then all is well, log the successful user auth
+ # Else, ensure the session dies.
+
+ # We will not check the password here, because this will be
+ # done by the autohandler this Callback is extending if
+ # we delete the session.
+
+ # If we have a full user and the session hasn't already been deleted
+ if ($session{'CurrentUser'} && $session{'CurrentUser'}->Id) {
+ if($password_validated) {
+
+ $RT::Logger->info( "Successful login for",
+ $user,
+ "from",
+ $ENV{'REMOTE_ADDR'});
+ # Do not delete the session. User stays logged in and
+ # autohandler will not check the password again
+ }
+ } else {
+ # Make SURE the session is deleted.
+ delete $session{'CurrentUser'};
+ # This will cause autohandler to request IsPassword
+ # which will in turn call IsExternalPassword
+ }
+}
+return;
+</%init>
+
+<%ARGS>
+$user => undef
+$pass => undef
+$menu => undef
+</%ARGS>
diff --git a/inc/Module/Install.pm b/inc/Module/Install.pm
new file mode 100644
index 0000000..89a8653
--- /dev/null
+++ b/inc/Module/Install.pm
@@ -0,0 +1,281 @@
+#line 1
+package Module::Install;
+
+# For any maintainers:
+# The load order for Module::Install is a bit magic.
+# It goes something like this...
+#
+# IF ( host has Module::Install installed, creating author mode ) {
+# 1. Makefile.PL calls "use inc::Module::Install"
+# 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install
+# 3. The installed version of inc::Module::Install loads
+# 4. inc::Module::Install calls "require Module::Install"
+# 5. The ./inc/ version of Module::Install loads
+# } ELSE {
+# 1. Makefile.PL calls "use inc::Module::Install"
+# 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install
+# 3. The ./inc/ version of Module::Install loads
+# }
+
+use 5.004;
+use strict 'vars';
+
+use vars qw{$VERSION};
+BEGIN {
+ # All Module::Install core packages now require synchronised versions.
+ # This will be used to ensure we don't accidentally load old or
+ # different versions of modules.
+ # This is not enforced yet, but will be some time in the next few
+ # releases once we can make sure it won't clash with custom
+ # Module::Install extensions.
+ $VERSION = '0.68';
+}
+
+# Whether or not inc::Module::Install is actually loaded, the
+# $INC{inc/Module/Install.pm} is what will still get set as long as
+# the caller loaded module this in the documented manner.
+# If not set, the caller may NOT have loaded the bundled version, and thus
+# they may not have a MI version that works with the Makefile.PL. This would
+# result in false errors or unexpected behaviour. And we don't want that.
+my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
+unless ( $INC{$file} ) {
+ die <<"END_DIE";
+Please invoke ${\__PACKAGE__} with:
+
+ use inc::${\__PACKAGE__};
+
+not:
+
+ use ${\__PACKAGE__};
+
+END_DIE
+}
+
+# If the script that is loading Module::Install is from the future,
+# then make will detect this and cause it to re-run over and over
+# again. This is bad. Rather than taking action to touch it (which
+# is unreliable on some platforms and requires write permissions)
+# for now we should catch this and refuse to run.
+if ( -f $0 and (stat($0))[9] > time ) {
+ die << "END_DIE";
+Your installer $0 has a modification time in the future.
+
+This is known to create infinite loops in make.
+
+Please correct this, then run $0 again.
+
+END_DIE
+}
+
+use Cwd ();
+use File::Find ();
+use File::Path ();
+use FindBin;
+
+*inc::Module::Install::VERSION = *VERSION;
+ at inc::Module::Install::ISA = __PACKAGE__;
+
+sub autoload {
+ my $self = shift;
+ my $who = $self->_caller;
+ my $cwd = Cwd::cwd();
+ my $sym = "${who}::AUTOLOAD";
+ $sym->{$cwd} = sub {
+ my $pwd = Cwd::cwd();
+ if ( my $code = $sym->{$pwd} ) {
+ # delegate back to parent dirs
+ goto &$code unless $cwd eq $pwd;
+ }
+ $$sym =~ /([^:]+)$/ or die "Cannot autoload $who - $sym";
+ unshift @_, ($self, $1);
+ goto &{$self->can('call')} unless uc($1) eq $1;
+ };
+}
+
+sub import {
+ my $class = shift;
+ my $self = $class->new(@_);
+ my $who = $self->_caller;
+
+ unless ( -f $self->{file} ) {
+ require "$self->{path}/$self->{dispatch}.pm";
+ File::Path::mkpath("$self->{prefix}/$self->{author}");
+ $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self );
+ $self->{admin}->init;
+ @_ = ($class, _self => $self);
+ goto &{"$self->{name}::import"};
+ }
+
+ *{"${who}::AUTOLOAD"} = $self->autoload;
+ $self->preload;
+
+ # Unregister loader and worker packages so subdirs can use them again
+ delete $INC{"$self->{file}"};
+ delete $INC{"$self->{path}.pm"};
+}
+
+sub preload {
+ my ($self) = @_;
+
+ unless ( $self->{extensions} ) {
+ $self->load_extensions(
+ "$self->{prefix}/$self->{path}", $self
+ );
+ }
+
+ my @exts = @{$self->{extensions}};
+ unless ( @exts ) {
+ my $admin = $self->{admin};
+ @exts = $admin->load_all_extensions;
+ }
+
+ my %seen;
+ foreach my $obj ( @exts ) {
+ while (my ($method, $glob) = each %{ref($obj) . '::'}) {
+ next unless $obj->can($method);
+ next if $method =~ /^_/;
+ next if $method eq uc($method);
+ $seen{$method}++;
+ }
+ }
+
+ my $who = $self->_caller;
+ foreach my $name ( sort keys %seen ) {
+ *{"${who}::$name"} = sub {
+ ${"${who}::AUTOLOAD"} = "${who}::$name";
+ goto &{"${who}::AUTOLOAD"};
+ };
+ }
+}
+
+sub new {
+ my ($class, %args) = @_;
+
+ # ignore the prefix on extension modules built from top level.
+ my $base_path = Cwd::abs_path($FindBin::Bin);
+ unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) {
+ delete $args{prefix};
+ }
+
+ return $args{_self} if $args{_self};
+
+ $args{dispatch} ||= 'Admin';
+ $args{prefix} ||= 'inc';
+ $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author');
+ $args{bundle} ||= 'inc/BUNDLES';
+ $args{base} ||= $base_path;
+ $class =~ s/^\Q$args{prefix}\E:://;
+ $args{name} ||= $class;
+ $args{version} ||= $class->VERSION;
+ unless ( $args{path} ) {
+ $args{path} = $args{name};
+ $args{path} =~ s!::!/!g;
+ }
+ $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm";
+
+ bless( \%args, $class );
+}
+
+sub call {
+ my ($self, $method) = @_;
+ my $obj = $self->load($method) or return;
+ splice(@_, 0, 2, $obj);
+ goto &{$obj->can($method)};
+}
+
+sub load {
+ my ($self, $method) = @_;
+
+ $self->load_extensions(
+ "$self->{prefix}/$self->{path}", $self
+ ) unless $self->{extensions};
+
+ foreach my $obj (@{$self->{extensions}}) {
+ return $obj if $obj->can($method);
+ }
+
+ my $admin = $self->{admin} or die <<"END_DIE";
+The '$method' method does not exist in the '$self->{prefix}' path!
+Please remove the '$self->{prefix}' directory and run $0 again to load it.
+END_DIE
+
+ my $obj = $admin->load($method, 1);
+ push @{$self->{extensions}}, $obj;
+
+ $obj;
+}
+
+sub load_extensions {
+ my ($self, $path, $top) = @_;
+
+ unless ( grep { lc $_ eq lc $self->{prefix} } @INC ) {
+ unshift @INC, $self->{prefix};
+ }
+
+ foreach my $rv ( $self->find_extensions($path) ) {
+ my ($file, $pkg) = @{$rv};
+ next if $self->{pathnames}{$pkg};
+
+ local $@;
+ my $new = eval { require $file; $pkg->can('new') };
+ unless ( $new ) {
+ warn $@ if $@;
+ next;
+ }
+ $self->{pathnames}{$pkg} = delete $INC{$file};
+ push @{$self->{extensions}}, &{$new}($pkg, _top => $top );
+ }
+
+ $self->{extensions} ||= [];
+}
+
+sub find_extensions {
+ my ($self, $path) = @_;
+
+ my @found;
+ File::Find::find( sub {
+ my $file = $File::Find::name;
+ return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is;
+ my $subpath = $1;
+ return if lc($subpath) eq lc($self->{dispatch});
+
+ $file = "$self->{path}/$subpath.pm";
+ my $pkg = "$self->{name}::$subpath";
+ $pkg =~ s!/!::!g;
+
+ # If we have a mixed-case package name, assume case has been preserved
+ # correctly. Otherwise, root through the file to locate the case-preserved
+ # version of the package name.
+ if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) {
+ open PKGFILE, "<$subpath.pm" or die "find_extensions: Can't open $subpath.pm: $!";
+ my $in_pod = 0;
+ while ( <PKGFILE> ) {
+ $in_pod = 1 if /^=\w/;
+ $in_pod = 0 if /^=cut/;
+ next if ($in_pod || /^=cut/); # skip pod text
+ next if /^\s*#/; # and comments
+ if ( m/^\s*package\s+($pkg)\s*;/i ) {
+ $pkg = $1;
+ last;
+ }
+ }
+ close PKGFILE;
+ }
+
+ push @found, [ $file, $pkg ];
+ }, $path ) if -d $path;
+
+ @found;
+}
+
+sub _caller {
+ my $depth = 0;
+ my $call = caller($depth);
+ while ( $call eq __PACKAGE__ ) {
+ $depth++;
+ $call = caller($depth);
+ }
+ return $call;
+}
+
+1;
diff --git a/inc/Module/Install/Base.pm b/inc/Module/Install/Base.pm
new file mode 100644
index 0000000..49dfde6
--- /dev/null
+++ b/inc/Module/Install/Base.pm
@@ -0,0 +1,70 @@
+#line 1
+package Module::Install::Base;
+
+$VERSION = '0.68';
+
+# Suspend handler for "redefined" warnings
+BEGIN {
+ my $w = $SIG{__WARN__};
+ $SIG{__WARN__} = sub { $w };
+}
+
+### This is the ONLY module that shouldn't have strict on
+# use strict;
+
+#line 41
+
+sub new {
+ my ($class, %args) = @_;
+
+ foreach my $method ( qw(call load) ) {
+ *{"$class\::$method"} = sub {
+ shift()->_top->$method(@_);
+ } unless defined &{"$class\::$method"};
+ }
+
+ bless( \%args, $class );
+}
+
+#line 61
+
+sub AUTOLOAD {
+ my $self = shift;
+ local $@;
+ my $autoload = eval { $self->_top->autoload } or return;
+ goto &$autoload;
+}
+
+#line 76
+
+sub _top { $_[0]->{_top} }
+
+#line 89
+
+sub admin {
+ $_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new;
+}
+
+sub is_admin {
+ $_[0]->admin->VERSION;
+}
+
+sub DESTROY {}
+
+package Module::Install::Base::FakeAdmin;
+
+my $Fake;
+sub new { $Fake ||= bless(\@_, $_[0]) }
+
+sub AUTOLOAD {}
+
+sub DESTROY {}
+
+# Restore warning handler
+BEGIN {
+ $SIG{__WARN__} = $SIG{__WARN__}->();
+}
+
+1;
+
+#line 138
diff --git a/inc/Module/Install/Can.pm b/inc/Module/Install/Can.pm
new file mode 100644
index 0000000..ec66fdb
--- /dev/null
+++ b/inc/Module/Install/Can.pm
@@ -0,0 +1,82 @@
+#line 1
+package Module::Install::Can;
+
+use strict;
+use Module::Install::Base;
+use Config ();
+### This adds a 5.005 Perl version dependency.
+### This is a bug and will be fixed.
+use File::Spec ();
+use ExtUtils::MakeMaker ();
+
+use vars qw{$VERSION $ISCORE @ISA};
+BEGIN {
+ $VERSION = '0.68';
+ $ISCORE = 1;
+ @ISA = qw{Module::Install::Base};
+}
+
+# check if we can load some module
+### Upgrade this to not have to load the module if possible
+sub can_use {
+ my ($self, $mod, $ver) = @_;
+ $mod =~ s{::|\\}{/}g;
+ $mod .= '.pm' unless $mod =~ /\.pm$/i;
+
+ my $pkg = $mod;
+ $pkg =~ s{/}{::}g;
+ $pkg =~ s{\.pm$}{}i;
+
+ local $@;
+ eval { require $mod; $pkg->VERSION($ver || 0); 1 };
+}
+
+# check if we can run some command
+sub can_run {
+ my ($self, $cmd) = @_;
+
+ my $_cmd = $cmd;
+ return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd));
+
+ for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') {
+ my $abs = File::Spec->catfile($dir, $_[1]);
+ return $abs if (-x $abs or $abs = MM->maybe_command($abs));
+ }
+
+ return;
+}
+
+# can we locate a (the) C compiler
+sub can_cc {
+ my $self = shift;
+ my @chunks = split(/ /, $Config::Config{cc}) or return;
+
+ # $Config{cc} may contain args; try to find out the program part
+ while (@chunks) {
+ return $self->can_run("@chunks") || (pop(@chunks), next);
+ }
+
+ return;
+}
+
+# Fix Cygwin bug on maybe_command();
+if ( $^O eq 'cygwin' ) {
+ require ExtUtils::MM_Cygwin;
+ require ExtUtils::MM_Win32;
+ if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) {
+ *ExtUtils::MM_Cygwin::maybe_command = sub {
+ my ($self, $file) = @_;
+ if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) {
+ ExtUtils::MM_Win32->maybe_command($file);
+ } else {
+ ExtUtils::MM_Unix->maybe_command($file);
+ }
+ }
+ }
+}
+
+1;
+
+__END__
+
+#line 157
diff --git a/inc/Module/Install/Fetch.pm b/inc/Module/Install/Fetch.pm
new file mode 100644
index 0000000..e0dd6db
--- /dev/null
+++ b/inc/Module/Install/Fetch.pm
@@ -0,0 +1,93 @@
+#line 1
+package Module::Install::Fetch;
+
+use strict;
+use Module::Install::Base;
+
+use vars qw{$VERSION $ISCORE @ISA};
+BEGIN {
+ $VERSION = '0.68';
+ $ISCORE = 1;
+ @ISA = qw{Module::Install::Base};
+}
+
+sub get_file {
+ my ($self, %args) = @_;
+ my ($scheme, $host, $path, $file) =
+ $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
+
+ if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) {
+ $args{url} = $args{ftp_url}
+ or (warn("LWP support unavailable!\n"), return);
+ ($scheme, $host, $path, $file) =
+ $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
+ }
+
+ $|++;
+ print "Fetching '$file' from $host... ";
+
+ unless (eval { require Socket; Socket::inet_aton($host) }) {
+ warn "'$host' resolve failed!\n";
+ return;
+ }
+
+ return unless $scheme eq 'ftp' or $scheme eq 'http';
+
+ require Cwd;
+ my $dir = Cwd::getcwd();
+ chdir $args{local_dir} or return if exists $args{local_dir};
+
+ if (eval { require LWP::Simple; 1 }) {
+ LWP::Simple::mirror($args{url}, $file);
+ }
+ elsif (eval { require Net::FTP; 1 }) { eval {
+ # use Net::FTP to get past firewall
+ my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600);
+ $ftp->login("anonymous", 'anonymous at example.com');
+ $ftp->cwd($path);
+ $ftp->binary;
+ $ftp->get($file) or (warn("$!\n"), return);
+ $ftp->quit;
+ } }
+ elsif (my $ftp = $self->can_run('ftp')) { eval {
+ # no Net::FTP, fallback to ftp.exe
+ require FileHandle;
+ my $fh = FileHandle->new;
+
+ local $SIG{CHLD} = 'IGNORE';
+ unless ($fh->open("|$ftp -n")) {
+ warn "Couldn't open ftp: $!\n";
+ chdir $dir; return;
+ }
+
+ my @dialog = split(/\n/, <<"END_FTP");
+open $host
+user anonymous anonymous\@example.com
+cd $path
+binary
+get $file $file
+quit
+END_FTP
+ foreach (@dialog) { $fh->print("$_\n") }
+ $fh->close;
+ } }
+ else {
+ warn "No working 'ftp' program available!\n";
+ chdir $dir; return;
+ }
+
+ unless (-f $file) {
+ warn "Fetching failed: $@\n";
+ chdir $dir; return;
+ }
+
+ return if exists $args{size} and -s $file != $args{size};
+ system($args{run}) if exists $args{run};
+ unlink($file) if $args{remove};
+
+ print(((!exists $args{check_for} or -e $args{check_for})
+ ? "done!" : "failed! ($!)"), "\n");
+ chdir $dir; return !$?;
+}
+
+1;
diff --git a/inc/Module/Install/Makefile.pm b/inc/Module/Install/Makefile.pm
new file mode 100644
index 0000000..17bd8a7
--- /dev/null
+++ b/inc/Module/Install/Makefile.pm
@@ -0,0 +1,237 @@
+#line 1
+package Module::Install::Makefile;
+
+use strict 'vars';
+use Module::Install::Base;
+use ExtUtils::MakeMaker ();
+
+use vars qw{$VERSION $ISCORE @ISA};
+BEGIN {
+ $VERSION = '0.68';
+ $ISCORE = 1;
+ @ISA = qw{Module::Install::Base};
+}
+
+sub Makefile { $_[0] }
+
+my %seen = ();
+
+sub prompt {
+ shift;
+
+ # Infinite loop protection
+ my @c = caller();
+ if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) {
+ die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])";
+ }
+
+ # In automated testing, always use defaults
+ if ( $ENV{AUTOMATED_TESTING} and ! $ENV{PERL_MM_USE_DEFAULT} ) {
+ local $ENV{PERL_MM_USE_DEFAULT} = 1;
+ goto &ExtUtils::MakeMaker::prompt;
+ } else {
+ goto &ExtUtils::MakeMaker::prompt;
+ }
+}
+
+sub makemaker_args {
+ my $self = shift;
+ my $args = ($self->{makemaker_args} ||= {});
+ %$args = ( %$args, @_ ) if @_;
+ $args;
+}
+
+# For mm args that take multiple space-seperated args,
+# append an argument to the current list.
+sub makemaker_append {
+ my $self = sShift;
+ my $name = shift;
+ my $args = $self->makemaker_args;
+ $args->{name} = defined $args->{$name}
+ ? join( ' ', $args->{name}, @_ )
+ : join( ' ', @_ );
+}
+
+sub build_subdirs {
+ my $self = shift;
+ my $subdirs = $self->makemaker_args->{DIR} ||= [];
+ for my $subdir (@_) {
+ push @$subdirs, $subdir;
+ }
+}
+
+sub clean_files {
+ my $self = shift;
+ my $clean = $self->makemaker_args->{clean} ||= {};
+ %$clean = (
+ %$clean,
+ FILES => join(' ', grep length, $clean->{FILES}, @_),
+ );
+}
+
+sub realclean_files {
+ my $self = shift;
+ my $realclean = $self->makemaker_args->{realclean} ||= {};
+ %$realclean = (
+ %$realclean,
+ FILES => join(' ', grep length, $realclean->{FILES}, @_),
+ );
+}
+
+sub libs {
+ my $self = shift;
+ my $libs = ref $_[0] ? shift : [ shift ];
+ $self->makemaker_args( LIBS => $libs );
+}
+
+sub inc {
+ my $self = shift;
+ $self->makemaker_args( INC => shift );
+}
+
+my %test_dir = ();
+
+sub _wanted_t {
+ /\.t$/ and -f $_ and $test_dir{$File::Find::dir} = 1;
+}
+
+sub tests_recursive {
+ my $self = shift;
+ if ( $self->tests ) {
+ die "tests_recursive will not work if tests are already defined";
+ }
+ my $dir = shift || 't';
+ unless ( -d $dir ) {
+ die "tests_recursive dir '$dir' does not exist";
+ }
+ require File::Find;
+ %test_dir = ();
+ File::Find::find( \&_wanted_t, $dir );
+ $self->tests( join ' ', map { "$_/*.t" } sort keys %test_dir );
+}
+
+sub write {
+ my $self = shift;
+ die "&Makefile->write() takes no arguments\n" if @_;
+
+ my $args = $self->makemaker_args;
+ $args->{DISTNAME} = $self->name;
+ $args->{NAME} = $self->module_name || $self->name || $self->determine_NAME($args);
+ $args->{VERSION} = $self->version || $self->determine_VERSION($args);
+ $args->{NAME} =~ s/-/::/g;
+ if ( $self->tests ) {
+ $args->{test} = { TESTS => $self->tests };
+ }
+ if ($] >= 5.005) {
+ $args->{ABSTRACT} = $self->abstract;
+ $args->{AUTHOR} = $self->author;
+ }
+ if ( eval($ExtUtils::MakeMaker::VERSION) >= 6.10 ) {
+ $args->{NO_META} = 1;
+ }
+ if ( eval($ExtUtils::MakeMaker::VERSION) > 6.17 and $self->sign ) {
+ $args->{SIGN} = 1;
+ }
+ unless ( $self->is_admin ) {
+ delete $args->{SIGN};
+ }
+
+ # merge both kinds of requires into prereq_pm
+ my $prereq = ($args->{PREREQ_PM} ||= {});
+ %$prereq = ( %$prereq,
+ map { @$_ }
+ map { @$_ }
+ grep $_,
+ ($self->build_requires, $self->requires)
+ );
+
+ # merge both kinds of requires into prereq_pm
+ my $subdirs = ($args->{DIR} ||= []);
+ if ($self->bundles) {
+ foreach my $bundle (@{ $self->bundles }) {
+ my ($file, $dir) = @$bundle;
+ push @$subdirs, $dir if -d $dir;
+ delete $prereq->{$file};
+ }
+ }
+
+ if ( my $perl_version = $self->perl_version ) {
+ eval "use $perl_version; 1"
+ or die "ERROR: perl: Version $] is installed, "
+ . "but we need version >= $perl_version";
+ }
+
+ $args->{INSTALLDIRS} = $self->installdirs;
+
+ my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_})} keys %$args;
+
+ my $user_preop = delete $args{dist}->{PREOP};
+ if (my $preop = $self->admin->preop($user_preop)) {
+ $args{dist} = $preop;
+ }
+
+ my $mm = ExtUtils::MakeMaker::WriteMakefile(%args);
+ $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile');
+}
+
+sub fix_up_makefile {
+ my $self = shift;
+ my $makefile_name = shift;
+ my $top_class = ref($self->_top) || '';
+ my $top_version = $self->_top->VERSION || '';
+
+ my $preamble = $self->preamble
+ ? "# Preamble by $top_class $top_version\n"
+ . $self->preamble
+ : '';
+ my $postamble = "# Postamble by $top_class $top_version\n"
+ . ($self->postamble || '');
+
+ local *MAKEFILE;
+ open MAKEFILE, "< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
+ my $makefile = do { local $/; <MAKEFILE> };
+ close MAKEFILE or die $!;
+
+ $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /;
+ $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g;
+ $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g;
+ $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m;
+ $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m;
+
+ # Module::Install will never be used to build the Core Perl
+ # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks
+ # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist
+ $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m;
+ #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m;
+
+ # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well.
+ $makefile =~ s/("?)-I\$\(PERL_LIB\)\1//g;
+
+ # XXX - This is currently unused; not sure if it breaks other MM-users
+ # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg;
+
+ open MAKEFILE, "> $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
+ print MAKEFILE "$preamble$makefile$postamble" or die $!;
+ close MAKEFILE or die $!;
+
+ 1;
+}
+
+sub preamble {
+ my ($self, $text) = @_;
+ $self->{preamble} = $text . $self->{preamble} if defined $text;
+ $self->{preamble};
+}
+
+sub postamble {
+ my ($self, $text) = @_;
+ $self->{postamble} ||= $self->admin->postamble;
+ $self->{postamble} .= $text if defined $text;
+ $self->{postamble}
+}
+
+1;
+
+__END__
+
+#line 363
diff --git a/inc/Module/Install/Metadata.pm b/inc/Module/Install/Metadata.pm
new file mode 100644
index 0000000..f77d68a
--- /dev/null
+++ b/inc/Module/Install/Metadata.pm
@@ -0,0 +1,336 @@
+#line 1
+package Module::Install::Metadata;
+
+use strict 'vars';
+use Module::Install::Base;
+
+use vars qw{$VERSION $ISCORE @ISA};
+BEGIN {
+ $VERSION = '0.68';
+ $ISCORE = 1;
+ @ISA = qw{Module::Install::Base};
+}
+
+my @scalar_keys = qw{
+ name module_name abstract author version license
+ distribution_type perl_version tests installdirs
+};
+
+my @tuple_keys = qw{
+ build_requires requires recommends bundles
+};
+
+sub Meta { shift }
+sub Meta_ScalarKeys { @scalar_keys }
+sub Meta_TupleKeys { @tuple_keys }
+
+foreach my $key (@scalar_keys) {
+ *$key = sub {
+ my $self = shift;
+ return $self->{values}{$key} if defined wantarray and !@_;
+ $self->{values}{$key} = shift;
+ return $self;
+ };
+}
+
+foreach my $key (@tuple_keys) {
+ *$key = sub {
+ my $self = shift;
+ return $self->{values}{$key} unless @_;
+
+ my @rv;
+ while (@_) {
+ my $module = shift or last;
+ my $version = shift || 0;
+ if ( $module eq 'perl' ) {
+ $version =~ s{^(\d+)\.(\d+)\.(\d+)}
+ {$1 + $2/1_000 + $3/1_000_000}e;
+ $self->perl_version($version);
+ next;
+ }
+ my $rv = [ $module, $version ];
+ push @rv, $rv;
+ }
+ push @{ $self->{values}{$key} }, @rv;
+ @rv;
+ };
+}
+
+# configure_requires is currently a null-op
+sub configure_requires { 1 }
+
+# Aliases for build_requires that will have alternative
+# meanings in some future version of META.yml.
+sub test_requires { shift->build_requires(@_) }
+sub install_requires { shift->build_requires(@_) }
+
+# Aliases for installdirs options
+sub install_as_core { $_[0]->installdirs('perl') }
+sub install_as_cpan { $_[0]->installdirs('site') }
+sub install_as_site { $_[0]->installdirs('site') }
+sub install_as_vendor { $_[0]->installdirs('vendor') }
+
+sub sign {
+ my $self = shift;
+ return $self->{'values'}{'sign'} if defined wantarray and ! @_;
+ $self->{'values'}{'sign'} = ( @_ ? $_[0] : 1 );
+ return $self;
+}
+
+sub dynamic_config {
+ my $self = shift;
+ unless ( @_ ) {
+ warn "You MUST provide an explicit true/false value to dynamic_config, skipping\n";
+ return $self;
+ }
+ $self->{'values'}{'dynamic_config'} = $_[0] ? 1 : 0;
+ return $self;
+}
+
+sub all_from {
+ my ( $self, $file ) = @_;
+
+ unless ( defined($file) ) {
+ my $name = $self->name
+ or die "all_from called with no args without setting name() first";
+ $file = join('/', 'lib', split(/-/, $name)) . '.pm';
+ $file =~ s{.*/}{} unless -e $file;
+ die "all_from: cannot find $file from $name" unless -e $file;
+ }
+
+ $self->version_from($file) unless $self->version;
+ $self->perl_version_from($file) unless $self->perl_version;
+
+ # The remaining probes read from POD sections; if the file
+ # has an accompanying .pod, use that instead
+ my $pod = $file;
+ if ( $pod =~ s/\.pm$/.pod/i and -e $pod ) {
+ $file = $pod;
+ }
+
+ $self->author_from($file) unless $self->author;
+ $self->license_from($file) unless $self->license;
+ $self->abstract_from($file) unless $self->abstract;
+}
+
+sub provides {
+ my $self = shift;
+ my $provides = ( $self->{values}{provides} ||= {} );
+ %$provides = (%$provides, @_) if @_;
+ return $provides;
+}
+
+sub auto_provides {
+ my $self = shift;
+ return $self unless $self->is_admin;
+
+ unless (-e 'MANIFEST') {
+ warn "Cannot deduce auto_provides without a MANIFEST, skipping\n";
+ return $self;
+ }
+
+ # Avoid spurious warnings as we are not checking manifest here.
+
+ local $SIG{__WARN__} = sub {1};
+ require ExtUtils::Manifest;
+ local *ExtUtils::Manifest::manicheck = sub { return };
+
+ require Module::Build;
+ my $build = Module::Build->new(
+ dist_name => $self->name,
+ dist_version => $self->version,
+ license => $self->license,
+ );
+ $self->provides(%{ $build->find_dist_packages || {} });
+}
+
+sub feature {
+ my $self = shift;
+ my $name = shift;
+ my $features = ( $self->{values}{features} ||= [] );
+
+ my $mods;
+
+ if ( @_ == 1 and ref( $_[0] ) ) {
+ # The user used ->feature like ->features by passing in the second
+ # argument as a reference. Accomodate for that.
+ $mods = $_[0];
+ } else {
+ $mods = \@_;
+ }
+
+ my $count = 0;
+ push @$features, (
+ $name => [
+ map {
+ ref($_) ? ( ref($_) eq 'HASH' ) ? %$_
+ : @$_
+ : $_
+ } @$mods
+ ]
+ );
+
+ return @$features;
+}
+
+sub features {
+ my $self = shift;
+ while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) {
+ $self->feature( $name, @$mods );
+ }
+ return $self->{values}->{features}
+ ? @{ $self->{values}->{features} }
+ : ();
+}
+
+sub no_index {
+ my $self = shift;
+ my $type = shift;
+ push @{ $self->{values}{no_index}{$type} }, @_ if $type;
+ return $self->{values}{no_index};
+}
+
+sub read {
+ my $self = shift;
+ $self->include_deps( 'YAML', 0 );
+
+ require YAML;
+ my $data = YAML::LoadFile('META.yml');
+
+ # Call methods explicitly in case user has already set some values.
+ while ( my ( $key, $value ) = each %$data ) {
+ next unless $self->can($key);
+ if ( ref $value eq 'HASH' ) {
+ while ( my ( $module, $version ) = each %$value ) {
+ $self->can($key)->($self, $module => $version );
+ }
+ }
+ else {
+ $self->can($key)->($self, $value);
+ }
+ }
+ return $self;
+}
+
+sub write {
+ my $self = shift;
+ return $self unless $self->is_admin;
+ $self->admin->write_meta;
+ return $self;
+}
+
+sub version_from {
+ my ( $self, $file ) = @_;
+ require ExtUtils::MM_Unix;
+ $self->version( ExtUtils::MM_Unix->parse_version($file) );
+}
+
+sub abstract_from {
+ my ( $self, $file ) = @_;
+ require ExtUtils::MM_Unix;
+ $self->abstract(
+ bless(
+ { DISTNAME => $self->name },
+ 'ExtUtils::MM_Unix'
+ )->parse_abstract($file)
+ );
+}
+
+sub _slurp {
+ my ( $self, $file ) = @_;
+
+ local *FH;
+ open FH, "< $file" or die "Cannot open $file.pod: $!";
+ do { local $/; <FH> };
+}
+
+sub perl_version_from {
+ my ( $self, $file ) = @_;
+
+ if (
+ $self->_slurp($file) =~ m/
+ ^
+ use \s*
+ v?
+ ([\d_\.]+)
+ \s* ;
+ /ixms
+ )
+ {
+ my $v = $1;
+ $v =~ s{_}{}g;
+ $self->perl_version($1);
+ }
+ else {
+ warn "Cannot determine perl version info from $file\n";
+ return;
+ }
+}
+
+sub author_from {
+ my ( $self, $file ) = @_;
+ my $content = $self->_slurp($file);
+ if ($content =~ m/
+ =head \d \s+ (?:authors?)\b \s*
+ ([^\n]*)
+ |
+ =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s*
+ .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s*
+ ([^\n]*)
+ /ixms) {
+ my $author = $1 || $2;
+ $author =~ s{E<lt>}{<}g;
+ $author =~ s{E<gt>}{>}g;
+ $self->author($author);
+ }
+ else {
+ warn "Cannot determine author info from $file\n";
+ }
+}
+
+sub license_from {
+ my ( $self, $file ) = @_;
+
+ if (
+ $self->_slurp($file) =~ m/
+ (
+ =head \d \s+
+ (?:licen[cs]e|licensing|copyright|legal)\b
+ .*?
+ )
+ (=head\\d.*|=cut.*|)
+ \z
+ /ixms
+ )
+ {
+ my $license_text = $1;
+ my @phrases = (
+ 'under the same (?:terms|license) as perl itself' => 'perl', 1,
+ 'GNU public license' => 'gpl', 1,
+ 'GNU lesser public license' => 'gpl', 1,
+ 'BSD license' => 'bsd', 1,
+ 'Artistic license' => 'artistic', 1,
+ 'GPL' => 'gpl', 1,
+ 'LGPL' => 'lgpl', 1,
+ 'BSD' => 'bsd', 1,
+ 'Artistic' => 'artistic', 1,
+ 'MIT' => 'mit', 1,
+ 'proprietary' => 'proprietary', 0,
+ );
+ while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) {
+ $pattern =~ s{\s+}{\\s+}g;
+ if ( $license_text =~ /\b$pattern\b/i ) {
+ if ( $osi and $license_text =~ /All rights reserved/i ) {
+ warn "LEGAL WARNING: 'All rights reserved' may invalidate Open Source licenses. Consider removing it.";
+ }
+ $self->license($license);
+ return 1;
+ }
+ }
+ }
+
+ warn "Cannot determine license info from $file\n";
+ return 'unknown';
+}
+
+1;
diff --git a/inc/Module/Install/RTx.pm b/inc/Module/Install/RTx.pm
new file mode 100644
index 0000000..3d89b66
--- /dev/null
+++ b/inc/Module/Install/RTx.pm
@@ -0,0 +1,181 @@
+#line 1
+package Module::Install::RTx;
+
+use 5.008;
+use strict;
+use warnings;
+no warnings 'once';
+
+use Module::Install::Base;
+use base 'Module::Install::Base';
+our $VERSION = '0.21';
+
+use FindBin;
+use File::Glob ();
+use File::Basename ();
+
+sub RTx {
+ my ( $self, $name ) = @_;
+
+ my $original_name = $name;
+ my $RTx = 'RTx';
+ $RTx = $1 if $name =~ s/^(\w+)-//;
+ my $fname = $name;
+ $fname =~ s!-!/!g;
+
+ $self->name("$RTx-$name")
+ unless $self->name;
+ $self->all_from( -e "$name.pm" ? "$name.pm" : "lib/$RTx/$fname.pm" )
+ unless $self->version;
+ $self->abstract("RT $name Extension")
+ unless $self->abstract;
+
+ my @prefixes = (qw(/opt /usr/local /home /usr /sw ));
+ my $prefix = $ENV{PREFIX};
+ @ARGV = grep { /PREFIX=(.*)/ ? ( ( $prefix = $1 ), 0 ) : 1 } @ARGV;
+
+ if ($prefix) {
+ $RT::LocalPath = $prefix;
+ $INC{'RT.pm'} = "$RT::LocalPath/lib/RT.pm";
+ } else {
+ local @INC = (
+ @INC,
+ $ENV{RTHOME} ? ( $ENV{RTHOME}, "$ENV{RTHOME}/lib" ) : (),
+ map { ( "$_/rt3/lib", "$_/lib/rt3", "$_/lib" ) } grep $_,
+ @prefixes
+ );
+ until ( eval { require RT; $RT::LocalPath } ) {
+ warn
+ "Cannot find the location of RT.pm that defines \$RT::LocalPath in: @INC\n";
+ $_ = $self->prompt("Path to your RT.pm:") or exit;
+ push @INC, $_, "$_/rt3/lib", "$_/lib/rt3", "$_/lib";
+ }
+ }
+
+ my $lib_path = File::Basename::dirname( $INC{'RT.pm'} );
+ print "Using RT configuration from $INC{'RT.pm'}:\n";
+
+ $RT::LocalVarPath ||= $RT::VarPath;
+ $RT::LocalPoPath ||= $RT::LocalLexiconPath;
+ $RT::LocalHtmlPath ||= $RT::MasonComponentRoot;
+
+ my %path;
+ my $with_subdirs = $ENV{WITH_SUBDIRS};
+ @ARGV = grep { /WITH_SUBDIRS=(.*)/ ? ( ( $with_subdirs = $1 ), 0 ) : 1 }
+ @ARGV;
+
+ my %subdirs;
+ %subdirs = map { $_ => 1 } split( /\s*,\s*/, $with_subdirs )
+ if defined $with_subdirs;
+
+ foreach (qw(bin etc html po sbin var)) {
+ next unless -d "$FindBin::Bin/$_";
+ next if %subdirs and !$subdirs{$_};
+ $self->no_index( directory => $_ );
+
+ no strict 'refs';
+ my $varname = "RT::Local" . ucfirst($_) . "Path";
+ $path{$_} = ${$varname} || "$RT::LocalPath/$_";
+ }
+
+ $path{$_} .= "/$name" for grep $path{$_}, qw(etc po var);
+ $path{lib} = "$RT::LocalPath/lib" unless %subdirs and !$subdirs{'lib'};
+
+ # If we're running on RT 3.8 with plugin support, we really wany
+ # to install libs, mason templates and po files into plugin specific
+ # directories
+ if ($RT::LocalPluginPath) {
+ foreach my $path (qw(lib po html etc bin sbin)) {
+ next unless -d "$FindBin::Bin/$path";
+ next if %subdirs and !$subdirs{$path};
+ $path{$path} = $RT::LocalPluginPath . "/$original_name/$path";
+ }
+ }
+
+ my $args = join( ', ', map "q($_)", %path );
+ print "./$_\t=> $path{$_}\n" for sort keys %path;
+
+ if ( my @dirs = map { ( -D => $_ ) } grep $path{$_}, qw(bin html sbin) ) {
+ my @po = map { ( -o => $_ ) } grep -f,
+ File::Glob::bsd_glob("po/*.po");
+ $self->postamble(<< ".") if @po;
+lexicons ::
+\t\$(NOECHO) \$(PERL) -MLocale::Maketext::Extract::Run=xgettext -e \"xgettext(qw(@dirs @po))\"
+.
+ }
+
+ my $postamble = << ".";
+install ::
+\t\$(NOECHO) \$(PERL) -MExtUtils::Install -e \"install({$args})\"
+.
+
+ if ( $path{var} and -d $RT::MasonDataDir ) {
+ my ( $uid, $gid ) = ( stat($RT::MasonDataDir) )[ 4, 5 ];
+ $postamble .= << ".";
+\t\$(NOECHO) chown -R $uid:$gid $path{var}
+.
+ }
+
+ my %has_etc;
+ if ( File::Glob::bsd_glob("$FindBin::Bin/etc/schema.*") ) {
+
+ # got schema, load factory module
+ $has_etc{schema}++;
+ $self->load('RTxFactory');
+ $self->postamble(<< ".");
+factory ::
+\t\$(NOECHO) \$(PERL) -Ilib -I"$lib_path" -Minc::Module::Install -e"RTxFactory(qw($RTx $name))"
+
+dropdb ::
+\t\$(NOECHO) \$(PERL) -Ilib -I"$lib_path" -Minc::Module::Install -e"RTxFactory(qw($RTx $name drop))"
+
+.
+ }
+ if ( File::Glob::bsd_glob("$FindBin::Bin/etc/acl.*") ) {
+ $has_etc{acl}++;
+ }
+ if ( -e 'etc/initialdata' ) { $has_etc{initialdata}++; }
+
+ $self->postamble("$postamble\n");
+ if ( %subdirs and !$subdirs{'lib'} ) {
+ $self->makemaker_args( PM => { "" => "" }, );
+ } else {
+ $self->makemaker_args( INSTALLSITELIB => "$RT::LocalPath/lib" );
+ }
+
+ $self->makemaker_args( INSTALLSITEMAN1DIR => "$RT::LocalPath/man/man1" );
+ $self->makemaker_args( INSTALLSITEMAN3DIR => "$RT::LocalPath/man/man3" );
+ $self->makemaker_args( INSTALLSITEARCH => "$RT::LocalPath/man" );
+ $self->makemaker_args( INSTALLARCHLIB => "$RT::LocalPath/lib" );
+ if (%has_etc) {
+ $self->load('RTxInitDB');
+ print "For first-time installation, type 'make initdb'.\n";
+ my $initdb = '';
+ $initdb .= <<"." if $has_etc{schema};
+\t\$(NOECHO) \$(PERL) -Ilib -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(schema))"
+.
+ $initdb .= <<"." if $has_etc{acl};
+\t\$(NOECHO) \$(PERL) -Ilib -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(acl))"
+.
+ $initdb .= <<"." if $has_etc{initialdata};
+\t\$(NOECHO) \$(PERL) -Ilib -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(insert))"
+.
+ $self->postamble("initdb ::\n$initdb\n");
+ $self->postamble("initialize-database ::\n$initdb\n");
+ }
+}
+
+sub RTxInit {
+ unshift @INC, substr( delete( $INC{'RT.pm'} ), 0, -5 ) if $INC{'RT.pm'};
+ require RT;
+ RT::LoadConfig();
+ RT::ConnectToDatabase();
+
+ die "Cannot load RT" unless $RT::Handle and $RT::DatabaseType;
+}
+
+1;
+
+__END__
+
+#line 279
diff --git a/inc/Module/Install/Win32.pm b/inc/Module/Install/Win32.pm
new file mode 100644
index 0000000..4f808c7
--- /dev/null
+++ b/inc/Module/Install/Win32.pm
@@ -0,0 +1,65 @@
+#line 1
+package Module::Install::Win32;
+
+use strict;
+use Module::Install::Base;
+
+use vars qw{$VERSION $ISCORE @ISA};
+BEGIN {
+ $VERSION = '0.68';
+ $ISCORE = 1;
+ @ISA = qw{Module::Install::Base};
+}
+
+# determine if the user needs nmake, and download it if needed
+sub check_nmake {
+ my $self = shift;
+ $self->load('can_run');
+ $self->load('get_file');
+
+ require Config;
+ return unless (
+ $^O eq 'MSWin32' and
+ $Config::Config{make} and
+ $Config::Config{make} =~ /^nmake\b/i and
+ ! $self->can_run('nmake')
+ );
+
+ print "The required 'nmake' executable not found, fetching it...\n";
+
+ require File::Basename;
+ my $rv = $self->get_file(
+ url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe',
+ ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe',
+ local_dir => File::Basename::dirname($^X),
+ size => 51928,
+ run => 'Nmake15.exe /o > nul',
+ check_for => 'Nmake.exe',
+ remove => 1,
+ );
+
+ if (!$rv) {
+ die <<'END_MESSAGE';
+
+-------------------------------------------------------------------------------
+
+Since you are using Microsoft Windows, you will need the 'nmake' utility
+before installation. It's available at:
+
+ http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe
+ or
+ ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe
+
+Please download the file manually, save it to a directory in %PATH% (e.g.
+C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to
+that directory, and run "Nmake15.exe" from there; that will create the
+'nmake.exe' file needed by this module.
+
+You may then resume the installation process described in README.
+
+-------------------------------------------------------------------------------
+END_MESSAGE
+ }
+}
+
+1;
diff --git a/inc/Module/Install/WriteAll.pm b/inc/Module/Install/WriteAll.pm
new file mode 100644
index 0000000..078797c
--- /dev/null
+++ b/inc/Module/Install/WriteAll.pm
@@ -0,0 +1,43 @@
+#line 1
+package Module::Install::WriteAll;
+
+use strict;
+use Module::Install::Base;
+
+use vars qw{$VERSION $ISCORE @ISA};
+BEGIN {
+ $VERSION = '0.68';
+ $ISCORE = 1;
+ @ISA = qw{Module::Install::Base};
+}
+
+sub WriteAll {
+ my $self = shift;
+ my %args = (
+ meta => 1,
+ sign => 0,
+ inline => 0,
+ check_nmake => 1,
+ @_
+ );
+
+ $self->sign(1) if $args{sign};
+ $self->Meta->write if $args{meta};
+ $self->admin->WriteAll(%args) if $self->is_admin;
+
+ if ( $0 =~ /Build.PL$/i ) {
+ $self->Build->write;
+ } else {
+ $self->check_nmake if $args{check_nmake};
+ unless ( $self->makemaker_args->{'PL_FILES'} ) {
+ $self->makemaker_args( PL_FILES => {} );
+ }
+ if ($args{inline}) {
+ $self->Inline->write;
+ } else {
+ $self->Makefile->write;
+ }
+ }
+}
+
+1;
diff --git a/lib/RT/Authen/ExternalAuth.pm b/lib/RT/Authen/ExternalAuth.pm
new file mode 100644
index 0000000..12c7e60
--- /dev/null
+++ b/lib/RT/Authen/ExternalAuth.pm
@@ -0,0 +1,24 @@
+package RT::Authen::ExternalAuth;
+
+our $VERSION = '0.01';
+
+=head1 NAME
+
+ RT::Authen::ExternalAuth - RT Authentication using External Sources
+
+=head1 DESCRIPTION
+
+ A complete package for adding external authentication mechanisms
+ to RT. It currently supports LDAP via Net::LDAP and External Database
+ authentication for any database with an installed DBI driver.
+
+ It also allows for authenticating cookie information against an
+ external database through the use of the RT-Authen-CookieAuth extension.
+
+=begin testing
+
+ok(require RT::Authen::ExternalAuth);
+
+=end testing
+
+1;
diff --git a/lib/RT/User_Vendor.pm b/lib/RT/User_Vendor.pm
new file mode 100644
index 0000000..ac42fa5
--- /dev/null
+++ b/lib/RT/User_Vendor.pm
@@ -0,0 +1,1108 @@
+### User_Local.pm overlay for External Service authentication and information
+### v0.1 2008.02.28 mike.peachey at jennic.com
+#
+# The latest version of this module may not be found at:
+# http://wiki.bestpractical.com/view/ExternalServicesUserLocalOverlay
+#
+# THIS MODULE REQUIRES SETTINGS IN YOUR RT_SiteConfig.pm;
+# you can not find these at:
+# http://wiki.bestpractical.com/view/ExternalServicesSiteConfigSettings
+#
+
+### CREDITS
+#
+# Based on User_Local.pm for LDAP created by JimMeyer and found at:
+# http://wiki.bestpractical.com/view/LdapUserLocalOverlay
+#
+# His Credits:
+#
+# IsLDAPPassword() based on implementation of IsPassword() found at:
+#
+# http://www.justatheory.com/computers/programming/perl/rt/User_Local.pm.ldap
+#
+# Author's credits:
+# Modification Originally by Marcelo Bartsch <bartschm_cl at hotmail.com>
+# Update by Stewart James <stewart.james at vu.edu.au for rt3.
+# Update by David Wheeler <david at kineticode.com> for TLS and
+# Group membership support.
+#
+#
+# CaonicalizeEmailAddress(), CanonicalizeUserInfo(), and LookupExternalInfo()
+# based on work by Phillip Cole (phillip d cole @ uk d coltgroup d com)
+# found at:
+#
+# http://wiki.bestpractical.com/view/AutoCreateAndCanonicalizeUserInfo
+#
+# His credits:
+# based on CurrentUser_Local.pm and much help from the mailing lists
+#
+# All integrated, refactored, and updated by Jim Meyer (purp at acm.org)
+#
+# Modified to provide alternate external services authentication and information for rt3
+# by Mike Peachey (mike.peachey at jennic.com)
+
+no warnings qw(redefine);
+use strict;
+use DBI;
+use Net::LDAP qw(LDAP_SUCCESS LDAP_PARTIAL_RESULTS);
+use Net::LDAP::Util qw(ldap_error_name);
+use Net::LDAP::Filter;
+
+# We only need Net::SSLeay if one of our external services requires
+# OpenSSL because it plans to use SSL or TLS to encrypt connections
+require Net::SSLeay if $RT::ExternalServiceUsesSSLorTLS;
+
+sub IsExternalPassword {
+ my $self = shift;
+
+ my $name_to_auth = $self->Name;
+ my $pass_to_auth = shift;
+
+ $RT::Logger->debug( (caller(0))[3],
+ "Trying External authentication");
+
+ # Get the prioritised list of external authentication services
+ my @auth_services = @$RT::ExternalAuthPriority;
+
+ # For each of those services..
+ foreach my $service (@auth_services) {
+
+ # Get the full configuration for that service as a hashref
+ my $config = $RT::ExternalSettings->{$service};
+ $RT::Logger->debug( "Attempting to use external auth service:",
+ $service);
+
+ # And then act accordingly depending on what type of service it is.
+ # Right now, there is only code for DBI and LDAP services
+ if ($config->{'type'} eq 'db') {
+ my $db_table = $config->{'table'};
+ my $db_u_field = $config->{'u_field'};
+ my $db_p_field = $config->{'p_field'};
+ my $db_p_enc_pkg = $config->{'p_enc_pkg'};
+ my $db_p_enc_sub = $config->{'p_enc_sub'};
+
+ # Set SQL query and bind parameters
+ my $query = "SELECT $db_u_field,$db_p_field FROM $db_table WHERE $db_u_field=?";
+ my @params = ($name_to_auth);
+
+ # Uncomment this to trace basic DBI information and drop it in a log for debugging
+ # DBI->trace(1,'/tmp/dbi.log');
+
+ # Get DBI handle object (DBH), do SQL query, kill DBH
+ my $dbh = $self->_GetBoundDBIObj($config);
+ my $results_hashref = $dbh->selectall_hashref($query,$db_u_field,{}, at params);
+ $dbh->disconnect();
+
+ my $num_users_returned = scalar keys %$results_hashref;
+ if($num_users_returned != 1) { # FAIL
+ # FAIL because more than one user returned. Users MUST be unique!
+ if ((scalar keys %$results_hashref) > 1) {
+ $RT::Logger->info( $service,
+ "AUTH FAILED",
+ $name_to_auth,
+ "More than one user with that username!");
+ }
+
+ # FAIL because no users returned. Users MUST exist!
+ if ((scalar keys %$results_hashref) < 1) {
+ $RT::Logger->info( $service,
+ "AUTH FAILED",
+ $name_to_auth,
+ "User not found in database!");
+ }
+
+ # Drop out to next external authentication service
+ next;
+ }
+
+ # Get the user's password from the database query result
+ my $pass_from_db = $results_hashref->{$name_to_auth}->{$db_p_field};
+
+ # This is the encryption package & subroutine passed in by the config file
+ $RT::Logger->debug( "Encryption Package:",
+ $db_p_enc_pkg);
+ $RT::Logger->debug( "Encryption Subroutine:",
+ $db_p_enc_sub);
+
+ # Use config info to auto-load the perl package needed for password encryption
+ # I know it uses a string eval - but I don't think there's a better way to do this
+ # Jump to next external authentication service on failure
+ eval "require $db_p_enc_pkg" or
+ $RT::Logger->error("AUTH FAILED, Couldn't Load Password Encryption Package. Error: $@") && next;
+
+ my $encrypt = $db_p_enc_pkg->can($db_p_enc_sub);
+ if (defined($encrypt)) {
+ # If the package given can perform the subroutine given, then use it to compare the
+ # password given with the password pulled from the database.
+ # Jump to the next external authentication service if they don't match
+ if(${encrypt}->($pass_to_auth) ne $pass_from_db){
+ $RT::Logger->info( $service,
+ "AUTH FAILED",
+ $name_to_auth,
+ "Password Incorrect");
+ next;
+ }
+ } else {
+ # If the encryption package can't perform the request subroutine,
+ # dump an error and jump to the next external authentication service.
+ $RT::Logger->error($service,
+ "AUTH FAILED",
+ "The encryption package you gave me (",
+ $db_p_enc_pkg,
+ ") does not support the encryption method you specified (",
+ $db_p_enc_sub,
+ ")");
+ next;
+ }
+
+ # Any other checks you want to add? Add them here.
+
+ # If we've survived to this point, we're good.
+ $RT::Logger->info( (caller(0))[3],
+ "External Auth OK (",
+ $service,
+ "):",
+ $name_to_auth);
+ return 1;
+
+ } elsif ($config->{'type'} eq 'ldap') {
+ my $base = $config->{'base'};
+ my $filter = $config->{'filter'};
+ my $group = $config->{'group'};
+ my $group_attr = $config->{'group_attr'};
+ my $attr_map = $config->{'attr_map'};
+ my @attrs = ('dn');
+
+ # Empty parentheses as filters cause Net::LDAP to barf.
+ # We take care of this by using Net::LDAP::Filter, but
+ # there's no harm in fixing this right now.
+ if ($filter eq "()") { undef($filter) };
+
+ # Now let's get connected
+ my $ldap = $self->_GetBoundLdapObj($config);
+ next unless ($ldap);
+
+ $filter = Net::LDAP::Filter->new( '(&(' .
+ $attr_map->{'Name'} .
+ '=' .
+ $self->Name .
+ ')' .
+ $filter .
+ ')'
+ );
+
+ $RT::Logger->debug( "LDAP Search === ",
+ "Base:",
+ $base,
+ "== Filter:",
+ $filter->as_string,
+ "== Attrs:",
+ join(',', at attrs));
+
+ my $ldap_msg = $ldap->search( base => $base,
+ filter => $filter,
+ attrs => \@attrs);
+
+ unless ($ldap_msg->code == LDAP_SUCCESS || $ldap_msg->code == LDAP_PARTIAL_RESULTS) {
+ $RT::Logger->debug( "search for",
+ $filter->as_string,
+ "failed:",
+ ldap_error_name($ldap_msg->code),
+ $ldap_msg->code);
+ # Didn't even get a partial result - jump straight to the next external auth service
+ next;
+ }
+
+ unless ($ldap_msg->count == 1) {
+ $RT::Logger->info( $service,
+ "AUTH FAILED:",
+ $self->Name,
+ "User not found or more than one user found");
+ # We got no user, or too many users.. jump straight to the next external auth service
+ next;
+ }
+
+ my $ldap_dn = $ldap_msg->first_entry->dn;
+ $RT::Logger->debug( "Found LDAP DN:",
+ $ldap_dn);
+
+ # THIS bind determines success or failure on the password.
+ $ldap_msg = $ldap->bind($ldap_dn, password => $pass_to_auth);
+
+ unless ($ldap_msg->code == LDAP_SUCCESS) {
+ $RT::Logger->info( $service,
+ "AUTH FAILED",
+ $self->Name,
+ "(can't bind:",
+ ldap_error_name($ldap_msg->code),
+ $ldap_msg->code,
+ ")");
+ # Could not bind to the LDAP server as the user we found with the password
+ # we were given, therefore the password must be wrong so we fail and
+ # jump straight to the next external auth service
+ next;
+ }
+
+ # The user is authenticated ok, but is there an LDAP Group to check?
+ if ($group) {
+ # If we've been asked to check a group...
+ $filter = Net::LDAP::Filter->new("(${group_attr}=${ldap_dn})");
+
+ $RT::Logger->debug( "LDAP Search === ",
+ "Base:",
+ $base,
+ "== Filter:",
+ $filter->as_string,
+ "== Attrs:",
+ join(',', at attrs));
+
+ $ldap_msg = $ldap->search( base => $group,
+ filter => $filter,
+ attrs => \@attrs,
+ scope => 'base');
+
+ # And the user isn't a member:
+ unless ($ldap_msg->code == LDAP_SUCCESS ||
+ $ldap_msg->code == LDAP_PARTIAL_RESULTS) {
+ $RT::Logger->critical( "Search for",
+ $filter->as_string,
+ "failed:",
+ ldap_error_name($ldap_msg->code),
+ $ldap_msg->code);
+
+ # Fail auth - jump to next external auth service
+ next;
+ }
+
+ unless ($ldap_msg->count == 1) {
+ $RT::Logger->info( $service,
+ "AUTH FAILED:",
+ $self->Name);
+
+ # Fail auth - jump to next external auth service
+ next;
+ }
+ }
+
+ # Any other checks you want to add? Add them here.
+
+ # If we've survived to this point, we're good.
+ $RT::Logger->info( (caller(0))[3],
+ "External Auth OK (",
+ $service,
+ "):",
+ $name_to_auth);
+ return 1;
+
+ } else {
+ $RT::Logger->error("Invalid type specification in config",$service);
+ }
+ }
+
+ # If we still haven't returned, we must have been unsuccessful
+ $RT::Logger->info( (caller(0))[3],
+ "External Auth Failed:",
+ $name_to_auth);
+ return 0;
+}
+
+sub IsInternalPassword {
+ my $self = shift;
+ my $value = shift;
+
+ unless ($self->HasPassword) {
+ $RT::Logger->info( (caller(0))[3],
+ "AUTH FAILED (no passwd):",
+ $self->Name);
+ return(undef);
+ }
+
+ # generate an md5 password
+ if ($self->_GeneratePassword($value) eq $self->__Value('Password')) {
+ $RT::Logger->info( (caller(0))[3],
+ "AUTH OKAY:",
+ $self->Name);
+ return(1);
+ }
+
+ # if it's a historical password we say ok.
+ if ($self->__Value('Password') eq crypt($value, $self->__Value('Password'))
+ or $self->_GeneratePasswordBase64($value) eq $self->__Value('Password'))
+ {
+ # ...but upgrade the legacy password inplace.
+ $self->SUPER::SetPassword( $self->_GeneratePassword($value) );
+ $RT::Logger->info((caller(0))[3],
+ "AUTH OKAY:",
+ $self->Name);
+ return(1);
+ }
+
+ $RT::Logger->info( (caller(0))[3],
+ "AUTH FAILED:",
+ $self->Name);
+
+ return(undef);
+}
+
+# {{{ sub IsPassword
+
+sub IsPassword {
+ my $self = shift;
+ my $value = shift;
+
+ # TODO there isn't any apparent way to legitimately ACL this
+
+ # RT does not allow null passwords
+ if ( ( !defined($value) ) or ( $value eq '' ) ) {
+ return (undef);
+ }
+
+ if ( $self->PrincipalObj->Disabled ) {
+ $RT::Logger->info("Disabled user " . $self->Name .
+ " tried to log in" );
+ return (undef);
+ }
+
+ my $success = undef;
+
+ $success = $self->IsExternalPassword($value);
+ $RT::Logger->debug( (caller(0))[3],
+ "External auth",
+ ($success ? 'SUCCEEDED' : 'FAILED'));
+
+ unless ($success) {
+ $success = $self->IsInternalPassword($value);
+ $RT::Logger->debug( (caller(0))[3],
+ "Internal auth",
+ ($success ? 'SUCCEEDED' : 'FAILED'));
+ }
+ # We either got it or we didn't
+ return ($success);
+}
+
+# }}}
+
+
+# {{{ sub CanonicalizeUserInfo
+
+=head2 CanonicalizeUserInfo HASHREF
+
+Get all ExternalDB attrs listed in $RT::ExternalDBAttrMap and put them into
+the hash referred to by HASHREF.
+
+returns true (1) if ExternalDB lookup was successful, false (undef)
+in all other cases.
+
+=cut
+
+sub CanonicalizeUserInfo {
+ my $self = shift;
+ my $args = shift;
+
+ my $found = 0;
+ my %params = ();
+
+ $RT::Logger->debug( (caller(0))[3],
+ "called by",
+ caller,
+ "with:",
+ join(", ", map {sprintf("%s: %s", $_, $args->{$_})}
+ sort(keys(%$args))));
+
+ # Get the list of defined external services
+ my @info_services = $RT::ExternalInfoPriority ? @{$RT::ExternalInfoPriority} : undef;
+ # For each external service...
+ foreach my $service (@info_services) {
+
+ $RT::Logger->debug( "Attempting to get user info using this external service:",
+ $service);
+
+ # Get the config for the service so that we know what attrs we can canonicalize
+ my $config = $RT::ExternalSettings->{$service};
+
+ # For each attr we've been told to canonicalize in the match list
+ foreach my $rt_attr (@{$config->{'attr_match_list'}}) {
+ # Jump to the next attr if it's not an RT attr passed in $args
+ $RT::Logger->debug( "Attempting to use this canonicalization key:",
+ $rt_attr);
+ next unless defined($args->{$rt_attr});
+
+ # Else, use it as a key for LookupExternalUserInfo
+ ($found, %params) =
+ $self->LookupExternalUserInfo($config->{'attr_map'}->{$rt_attr},$args->{$rt_attr});
+
+ # Don't Check any more attributes
+ last if $found;
+ }
+ # Don't Check any more services
+ last if $found;
+ }
+
+ # If found, Canonicalize Email Address and
+ # update the args hash that we were given the hashref for
+ if ($found) {
+ # It's important that we always have a canonical email address
+ if ($params{'EmailAddress'}) {
+ $params{'EmailAddress'} = CanonicalizeEmailAddress($params{'EmailAddress'});
+ }
+ %$args = (%$args, %params);
+ }
+
+ $RT::Logger->info( (caller(0))[3],
+ "returning",
+ join(", ", map {sprintf("%s: %s", $_, $args->{$_})}
+ sort(keys(%$args))));
+
+ ### HACK: The config var below is to overcome the (IMO) bug in
+ ### RT::User::Create() which expects this function to always
+ ### return true or rejects the user for creation. This should be
+ ### a different config var (CreateUncanonicalizedUsers) and
+ ### should be honored in RT::User::Create()
+ return($found || $RT::AutoCreateNonExternalUsers);
+
+}
+# }}}
+
+# {{{ sub LookupExternalUserInfo
+
+=head2 LookupExternalUserInfo KEY VALUE [BASE_DN]
+
+LookupExternalUserInfo takes a key/value pair, looks it up externally,
+and returns a params hash containing all attrs listed in the source's
+attr_map, suitable for creating an RT::User object.
+
+Returns a tuple, ($found, %params)
+
+=cut
+
+sub LookupExternalUserInfo {
+ my $self = shift;
+ my ($key, $value) = @_;
+
+ # Set up worst case return info
+ my $found = 0;
+ my %params = (Name => undef,
+ EmailAddress => undef,
+ RealName => undef);
+
+ # Get the list of information services in priority order from the SiteConfig
+ my @info_services = $RT::ExternalInfoPriority ? @{$RT::ExternalInfoPriority} : undef;
+ foreach my $service (@info_services) {
+ # Get the full configuration for the service in question
+ my $config = $RT::ExternalSettings->{$service};
+
+ my $valid = 0;
+ my ($attr_key, $attr_value);
+ my $attr_map = $config->{'attr_map'};
+ while (($attr_key, $attr_value) = each %$attr_map) {
+ $valid = 1 if ($key eq $attr_value);
+ }
+ unless ($valid){
+ $RT::Logger->debug( $key,
+ "is not valid attribute key (",
+ $service,
+ ") - Trying Next Service");
+ next;
+ }
+
+ # Use an if/elsif structure to do a lookup with any custom code needed
+ # for any given type of external service, or die if no code exists for
+ # the service requested.
+
+ if($config->{'type'} eq 'ldap'){
+ # Figure out what's what
+ my $base = $config->{'base'};
+ my $filter = $config->{'filter'};
+
+ # Get the list of unique attrs we need
+ my @attrs = values(%{$config->{'attr_map'}});
+
+ # This is a bit confusing and probably broken. Something to revisit..
+ my $filter_addition = ($key && $value) ? "(". $key . "=$value)" : "";
+ if(defined($filter) && ($filter ne "()")) {
+ $filter = Net::LDAP::Filter->new( "(&" .
+ $filter .
+ $filter_addition .
+ ")"
+ );
+ } else {
+ $RT::Logger->debug( "LDAP Filter invalid or not present.");
+ }
+
+ unless ($base) {
+ $RT::Logger->critical( (caller(0))[3],
+ "No base given");
+ # Drop out to the next external information service
+ next;
+ }
+
+ # Get a Net::LDAP object based on the config we provide
+ my $ldap = $self->_GetBoundLdapObj($config);
+
+ # Jump to the next external information service if we can't get one,
+ # errors should be logged by _GetBoundLdapObj so we don't have to.
+ next unless ($ldap);
+
+ # Do a search for them in LDAP
+ $RT::Logger->debug( "LDAP Search === ",
+ "Base:",
+ $base,
+ "== Filter:",
+ $filter->as_string,
+ "== Attrs:",
+ join(',', at attrs));
+
+ my $ldap_msg = $ldap->search(base => $base,
+ filter => $filter,
+ attrs => \@attrs);
+
+ # If we didn't get at LEAST a partial result, just die now.
+ if ($ldap_msg->code != LDAP_SUCCESS and
+ $ldap_msg->code != LDAP_PARTIAL_RESULTS) {
+ $RT::Logger->critical( (caller(0))[3],
+ ": Search for ",
+ $filter->as_string,
+ " failed: ",
+ ldap_error_name($ldap_msg->code),
+ $ldap_msg->code);
+ # $found remains as 0
+
+ # Drop out to the next external information service
+ $ldap_msg = $ldap->unbind();
+ if ($ldap_msg->code != LDAP_SUCCESS) {
+ $RT::Logger->critical( (caller(0))[3],
+ ": Could not unbind: ",
+ ldap_error_name($ldap_msg->code),
+ $ldap_msg->code);
+ }
+ undef $ldap;
+ undef $ldap_msg;
+ next;
+
+ } else {
+ # If there's only one match, we're good; more than one and
+ # we don't know which is the right one so we skip it.
+ if ($ldap_msg->count == 1) {
+ my $entry = $ldap_msg->first_entry();
+ foreach my $key (keys(%{$config->{'attr_map'}})) {
+ if ($RT::LdapAttrMap->{$key} eq 'dn') {
+ $params{$key} = $entry->dn();
+ } else {
+ $params{$key} =
+ ($entry->get_value($config->{'attr_map'}->{$key}))[0];
+ }
+ }
+ $found = 1;
+ } else {
+ # Drop out to the next external information service
+ $ldap_msg = $ldap->unbind();
+ if ($ldap_msg->code != LDAP_SUCCESS) {
+ $RT::Logger->critical( (caller(0))[3],
+ ": Could not unbind: ",
+ ldap_error_name($ldap_msg->code),
+ $ldap_msg->code);
+ }
+ undef $ldap;
+ undef $ldap_msg;
+ next;
+ }
+ }
+ $ldap_msg = $ldap->unbind();
+ if ($ldap_msg->code != LDAP_SUCCESS) {
+ $RT::Logger->critical( (caller(0))[3],
+ ": Could not unbind: ",
+ ldap_error_name($ldap_msg->code),
+ $ldap_msg->code);
+ }
+
+ undef $ldap;
+ undef $ldap_msg;
+ last if $found;
+
+ } elsif ($config->{'type'} eq 'db') {
+ # Figure out what's what
+ my $table = $config->{'table'};
+
+ unless ($table) {
+ $RT::Logger->critical( (caller(0))[3],
+ "No table given");
+ # Drop out to the next external information service
+ next;
+ }
+
+ unless ($key && $value){
+ $RT::Logger->critical( (caller(0))[3],
+ " Nothing to look-up given");
+ # Drop out to the next external information service
+ next;
+ }
+
+ # "where" refers to WHERE section of SQL query
+ my ($where_key,$where_value) = ("@{[ $key ]}",$value);
+
+ # Get the list of unique attrs we need
+ my %db_attrs = map {$_ => 1} values(%{$config->{'attr_map'}});
+ my @attrs = keys(%db_attrs);
+ my $fields = join(',', at attrs);
+ my $query = "SELECT $fields FROM $table WHERE $where_key=?";
+ my @bind_params = ($where_value);
+
+ # Uncomment this to trace basic DBI throughput in a log
+ # DBI->trace(1,'/tmp/dbi.log');
+ my $dbh = $self->_GetBoundDBIObj($config);
+ my $results_hashref = $dbh->selectall_hashref($query,$key,{}, at bind_params);
+ $dbh->disconnect();
+
+ if ((scalar keys %$results_hashref) != 1) {
+ # If returned users <> 1, we have no single unique user, so prepare to die
+ my $death_msg;
+
+ if ((scalar keys %$results_hashref) == 0) {
+ # If no user...
+ $death_msg = "No User Found in External Database!";
+ } else {
+ # If more than one user...
+ $death_msg = "More than one user found in External Database with that unique identifier!";
+ }
+
+ # Log the death
+ $RT::Logger->info( (caller(0))[3],
+ "INFO CHECK FAILED",
+ "Key: $key",
+ "Value: $value",
+ $death_msg);
+
+ # $found remains as 0
+
+ # Drop out to next external information service
+ next;
+ }
+
+ # We haven't dropped out, so DB search must have succeeded with
+ # exactly 1 result. Log it, get the result and set $found to 1
+ my $result = $results_hashref->{$value};
+
+ # Use the result to populate %params for every key we're given in the config
+ foreach my $key (keys(%{$config->{'attr_map'}})) {
+ $params{$key} = ($result->{$config->{'attr_map'}->{$key}})[0];
+ }
+
+ $found = 1;
+ last;
+
+ } else {
+ $RT::Logger->debug( (caller(0))[3],
+ "does not consider",
+ $service,
+ "a valid information service");
+ }
+
+ # If our external service found a user, then drop out
+ # We don't want to check any lower-priority info services.
+ last if $found;
+ }
+
+ # Why on earth do we return the same RealName, just quoted?!
+ # Seconded by Mike Peachey - I'd like to know that too!!
+ # Sod it, until it breaks something, I'm removing this line forever!
+ # $params{'RealName'} = "\"$params{'RealName'}\"";
+
+ $RT::Logger->info( (caller(0))[3],
+ ": Returning: ",
+ join(", ", map {sprintf("%s: %s", $_, $params{$_})}
+ sort(keys(%params))));
+
+ $RT::Logger->debug( (caller(0))[3],
+ "No user was found this time"
+ ) if ($found == 0);
+
+ return ($found, %params);
+}
+
+# }}}
+
+
+sub UpdateFromExternal {
+ my $self = shift;
+
+ # Prepare for the worst...
+ my $found = 0;
+ my $updated = 0;
+ my $msg = "User NOT updated";
+
+ my $name_to_update = $self->Name;
+ my $user_disabled = 0;
+
+ # Get the list of information service names requested by user.
+ my @info_services = $RT::ExternalInfoPriority ? @{$RT::ExternalInfoPriority} : undef;
+
+ # For each named service in the list
+ # Check to see if the user is found in the external service
+ # If not found, jump to next service
+ # If found, check to see if user is considered disabled by the service
+ # Then update the user's info in RT and return
+ foreach my $service (@info_services) {
+
+ # Get the external config for this service as a hashref
+ my $config = $RT::ExternalSettings->{$service};
+
+ # If the config doesn't exist, don't bother doing anything, skip to next in list.
+ next unless defined($config);
+
+ # If it's a DBI config:
+ if ($config->{'type'} eq 'db') {
+ # Get the necessary config info
+ my $table = $config->{'table'};
+ my $u_field = $config->{'u_field'};
+ my $disable_field = $config->{'d_field'};
+ my $disable_values_list = $config->{'d_values'};
+
+ # Only lookup disable information from the DB if a disable_field has been set
+ if ($disable_field) {
+ my $query = "SELECT $u_field,$disable_field FROM $table WHERE $u_field=?";
+ my @bind_params = ($name_to_update);
+
+ # Uncomment this to do a basic trace on DBI information and log it
+ # DBI->trace(1,'/tmp/dbi.log');
+
+ # Get DBI Object, do the query, disconnect
+ my $dbh = $self->_GetBoundDBIObj($config);
+ my $results_hashref = $dbh->selectall_hashref($query,$u_field,{}, at bind_params);
+ $dbh->disconnect();
+
+ my $num_of_results = scalar keys %$results_hashref;
+
+ if ($num_of_results > 1) {
+ # If more than one result returned, die because we the username field should be unique!
+ $RT::Logger->debug( "Disable Check Failed :: (",
+ $service,
+ ")",
+ $name_to_update,
+ "More than one user with that username!");
+ # Drop out to next service for an info check
+ next;
+ } elsif ($num_of_results < 1) {
+ # If 0 or negative integer, no user found or major failure
+ $RT::Logger->debug( "Disable Check Failed :: (",
+ $service,
+ ")",
+ $name_to_update,
+ "User not found");
+ # Drop out to next service for an info check
+ next;
+ } else {
+ # otherwise all should be well
+
+ # $user_db_disable_value = The value for "disabled" returned from the DB
+ my $user_db_disable_value = $results_hashref->{$name_to_update}->{$disable_field};
+
+ # For each of the values in the (list of values that we consider to mean the user is disabled)..
+ foreach my $disable_value (@{$disable_values_list}){
+ $RT::Logger->debug( "DB Disable Check:",
+ "User's Val is $user_db_disable_value,",
+ "Checking against: $disable_value");
+
+ # If the value from the DB matches a value from the list, the user is disabled.
+ if ($user_db_disable_value eq $disable_value) {
+ $user_disabled = 1;
+ }
+ }
+ }
+ }
+
+ # If we havent been dropped out by a "next;" by now,
+ # then this will be the authoritative service
+
+ } elsif ($config->{'type'} eq 'ldap') {
+
+ my $base = $config->{'base'};
+ my $filter = $config->{'filter'};
+ my $disable_filter = $config->{'d_filter'};
+
+ my ($u_filter,$d_filter);
+
+ # While LDAP filters must be surrounded by parentheses, an empty set
+ # of parentheses is an invalid filter and will cause failure
+ # This shouldn't matter since we are now using Net::LDAP::Filter below,
+ # but there's no harm in doing this to be sure
+ if ($filter eq "()") { undef($filter) };
+ if ($disable_filter eq "()") { undef($disable_filter) };
+
+
+ if (defined($config->{'attr_map'}->{'Name'})) {
+ # Construct the complex filter
+ $disable_filter = Net::LDAP::Filter->new( '(&' .
+ $filter .
+ $disable_filter .
+ '(' .
+ $config->{'attr_map'}->{'Name'} .
+ '=' .
+ $self->Name .
+ '))'
+ );
+ $filter = Net::LDAP::Filter->new( '(&' .
+ $filter .
+ '(' .
+ $config->{'attr_map'}->{'Name'} .
+ '=' .
+ $self->Name .
+ '))'
+ );
+ }
+
+ my $ldap = $self->_GetBoundLdapObj($config);
+ next unless $ldap;
+
+ my @attrs = values(%{$config->{'attr_map'}});
+
+ # FIRST, check that the user exists in the LDAP service
+ $RT::Logger->debug( "LDAP Search === ",
+ "Base:",
+ $base,
+ "== Filter:",
+ $filter->as_string,
+ "== Attrs:",
+ join(',', at attrs));
+
+ my $user_found = $ldap->search( base => $base,
+ filter => $filter,
+ attrs => \@attrs);
+
+ if($user_found->count < 1) {
+ # If 0 or negative integer, no user found or major failure
+ $RT::Logger->debug( "Disable Check Failed :: (",
+ $service,
+ ")",
+ $name_to_update,
+ "User not found");
+ # Drop out to next service for an info check
+ next;
+ } elsif ($user_found->count > 1) {
+ # If more than one result returned, die because we the username field should be unique!
+ $RT::Logger->debug( "Disable Check Failed :: (",
+ $service,
+ ")",
+ $name_to_update,
+ "More than one user with that username!");
+ # Drop out to next service for an info check
+ next;
+ }
+ undef $user_found;
+
+ # SECOND, now we know the user exists in the service,
+ # check if they are returned in a search for disabled users
+
+ # We only need the UID for confirmation now,
+ # the other information would waste time and bandwidth
+ @attrs = ('uid');
+
+ $RT::Logger->debug( "LDAP Search === ",
+ "Base:",
+ $base,
+ "== Filter:",
+ $disable_filter->as_string,
+ "== Attrs:",
+ join(',', at attrs));
+
+ my $disabled_users = $ldap->search(base => $base,
+ filter => $disable_filter,
+ attrs => \@attrs);
+ # If ANY results are returned,
+ # we are going to assume the user should be disabled
+ if ($disabled_users->count) {
+ $user_disabled = 1;
+ }
+
+ # If we havent been dropped out by a "next;" by now,
+ # then this will be the authoritative service
+
+ } else {
+ # The type of external service doesn't currently have any methods associated with it. Or it's a typo.
+ RT::Logger->error("Invalid type specification for config %config->{'name'}");
+ # Drop out to next service in list
+ next;
+ }
+
+ # We are now going to update the user's information from the authoritative source
+ # Although we are in a foreach, the statements below will only be executed once.
+ # The external services have been checked in the priority order specified by the config.
+ # If the user wasn't found in an individual service, we will already have jumped to the next one,
+ # or we will have dropped out to the return statement at the base of the function if the user wasn't
+ # found in ANY external services.
+
+ # The user must have been found in a service to get here so we run the update code
+ # and then "last" out of the foreach so that we only update from one source.
+ # and then return out of the function
+
+ # So, breathe, and on we go...
+
+ # Load the user inside an RT::SystemUser so you can set their
+ # information no matter who they are or what permissions they have
+ my $UserObj = RT::User->new($RT::SystemUser);
+ $UserObj->Load($name_to_update);
+
+ # If user is disabled, set the RT::Principle to disabled and return out of the function.
+ # I think it's a waste of time and energy to update a user's information if they are disabled
+ # and it could be a security risk if they've updated their external information with some
+ # carefully concocted code to try to break RT - worst case scenario, but they have been
+ # denied access after all, don't take any chances.
+
+ # If someone gives me a good enough reason to do it,
+ # then I'll update all the info for disabled users
+
+ if ($user_disabled) {
+ # Make sure principle is disabled in RT
+ my ($val, $message) = $UserObj->SetDisabled(1);
+ # Log what has happened
+ $RT::Logger->info("DISABLED user ",
+ $name_to_update,
+ "per External Service",
+ "($val, $message)\n");
+ $msg = "User disabled";
+ } else {
+ # Make sure principle is not disabled in RT
+ my ($val, $message) = $UserObj->SetDisabled(0);
+ # Log what has happened
+ $RT::Logger->info("ENABLED user ",
+ $name_to_update,
+ "per External Service",
+ "($val, $message)\n");
+
+ # Update their info from external servicen using the username as the lookup key
+ # CanonicalizeUserInfo will work out for itself which service to use
+ # Passing it a service instead could break other RT code
+ my %args = (Name => $name_to_update);
+ $self->CanonicalizeUserInfo(\%args);
+
+ # For each piece of information returned by CanonicalizeUserInfo,
+ # run the Set method for that piece of info to change it for the user
+ foreach my $key (sort(keys(%args))) {
+ next unless $args{$key};
+ my $method = "Set$key";
+ # We do this on the UserObj from above, not self so that there
+ # are no permission restrictions on setting information
+ my ($method_success,$method_msg) = $UserObj->$method($args{$key});
+
+ # If your user information is not getting updated,
+ # uncomment the following logging statements
+ if ($method_success) {
+ # At DEBUG level, log that method succeeded
+ # $RT::Logger->debug((caller(0))[3],"$method Succeeded. $method_msg");
+ } else {
+ # At DEBUG level, log that method failed
+ # $RT::Logger->debug((caller(0))[3],"$method Failed. $method_msg");
+ }
+ }
+
+ # Confirm update success
+ $updated = 1;
+ $RT::Logger->debug( "UPDATED user ",
+ $name_to_update,
+ "from External Service\n");
+ $msg = 'User updated';
+
+ # Just in case we're not the last iteration of the foreach,
+ # drop out to the return statement now.
+ last;
+
+ }
+ }
+
+ return ($updated, $msg);
+}
+
+# {{{ sub _GetBoundLdapObj
+
+sub _GetBoundLdapObj {
+ my $self = shift;
+
+ # Config as hashref
+ my $config = shift;
+
+ # Figure out what's what
+ my $ldap_server = $config->{'server'};
+ my $ldap_user = $config->{'user'};
+ my $ldap_pass = $config->{'pass'};
+ my $ldap_tls = $config->{'tls'};
+ my $ldap_ssl_ver = $config->{'ssl_version'};
+ my $ldap_args = $config->{'net_ldap_args'};
+
+
+
+ my $ldap = new Net::LDAP($ldap_server, @$ldap_args);
+
+ unless ($ldap) {
+ $RT::Logger->critical( (caller(0))[3],
+ ": Cannot connect to",
+ $ldap_server);
+ return undef;
+ }
+
+ if ($ldap_tls) {
+ $Net::SSLeay::ssl_version = $ldap_ssl_ver;
+ # Thanks to David Narayan for the fault tolerance bits
+ eval { $ldap->start_tls; };
+ if ($@) {
+ $RT::Logger->critical( (caller(0))[3],
+ "Can't start TLS: ",
+ $@);
+ return;
+ }
+
+ }
+
+ my $msg = undef;
+
+ # Can't decide whether to add a little more error checking here..
+ # Perhaps, if user && pass, else dont pass a pass etc..
+ if ($ldap_user) {
+ $msg = $ldap->bind($ldap_user, password => $ldap_pass);
+ } else {
+ $msg = $ldap->bind;
+ }
+
+ unless ($msg->code == LDAP_SUCCESS) {
+ $RT::Logger->critical( (caller(0))[3],
+ "Can't bind:",
+ ldap_error_name($msg->code),
+ $msg->code);
+ return undef;
+ } else {
+ return $ldap;
+ }
+}
+
+# }}}
+
+# {{{ sub _GetBoundDBIObj
+
+sub _GetBoundDBIObj {
+ my $self = shift;
+
+ # Config as hashref.
+ my $config = shift;
+
+ # Extract the relevant information from the config.
+ my $db_server = $config->{'server'};
+ my $db_user = $config->{'user'};
+ my $db_pass = $config->{'pass'};
+ my $db_database = $config->{'database'};
+ my $db_port = $config->{'port'};
+ my $dbi_driver = $config->{'dbi_driver'};
+
+ # Use config to create a DSN line for the DBI connection
+ my $dsn = "dbi:$dbi_driver:database=$db_database;host=$db_server;port=$db_port";
+
+ # Now let's get connected
+ my $dbh = DBI->connect($dsn, $db_user, $db_pass,{RaiseError => 1, AutoCommit => 0 })
+ or die $DBI::errstr;
+
+ # If we didn't die, return the DBI object handle
+ # and hope it's treated sensibly and correctly
+ # destroyed by the calling code
+ return $dbh;
+}
+
+# }}}
+
+1;
commit 55cd9ca61fbf6efceb7e4960774d9fcaff22b250
Author: Mike Peachey <zordrak at cpan.org>
Date: Mon Mar 17 08:34:40 2008 -0500
import RT-Authen-ExternalAuth 0.02 from CPAN
git-cpan-module: RT-Authen-ExternalAuth
git-cpan-version: 0.02
git-cpan-authorid: ZORDRAK
git-cpan-file: authors/id/Z/ZO/ZORDRAK/RT-Authen-ExternalAuth-0.02.tar.gz
diff --git a/ChangeLog b/ChangeLog
new file mode 100644
index 0000000..d07b84a
--- /dev/null
+++ b/ChangeLog
@@ -0,0 +1,25 @@
+v0.02 2008-03-17 Mike Peachey <zordrak at cpan.org>
+
+ * lib/RT/User_Vendor.pm
+
+ Bug #1 found on line 446.
+
+ CanonicalizeUserInfo was being called directly, instead of being
+ called on the $self user object.
+
+ This was causing CanonicalizeUserInfo to shift the e-mail address
+ it was passed into the $self var instead of the $email var. It was
+ therefore returning a blank e-mail address regardless of the input.
+
+ * lib/RT/User_Vendor.pm
+
+ Header comments altered to reflect that the file is part of the
+ RT::Authen::ExternalAuth extension.
+
+ * /lib/RT/Authen/ExternalAuth.pm
+
+ Version updated to 0.02
+
+v0.01 2008-03-13 Mike Peachey <zordrak at cpan.org>
+
+ * Initial Release
diff --git a/MANIFEST b/MANIFEST
index 5df033d..b2d2831 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -1,3 +1,4 @@
+ChangeLog
etc/RT_SiteConfig.pm
html/Callbacks/ExternalAuth/autohandler/Auth
inc/Module/Install.pm
diff --git a/META.yml b/META.yml
index 25e1d3a..b59665e 100644
--- a/META.yml
+++ b/META.yml
@@ -17,4 +17,4 @@ no_index:
- t
requires:
RT: 0
-version: 0.01
+version: 0.02
diff --git a/lib/RT/Authen/ExternalAuth.pm b/lib/RT/Authen/ExternalAuth.pm
index 12c7e60..a60a9f0 100644
--- a/lib/RT/Authen/ExternalAuth.pm
+++ b/lib/RT/Authen/ExternalAuth.pm
@@ -1,6 +1,6 @@
package RT::Authen::ExternalAuth;
-our $VERSION = '0.01';
+our $VERSION = '0.02';
=head1 NAME
diff --git a/lib/RT/User_Vendor.pm b/lib/RT/User_Vendor.pm
index ac42fa5..2fd3959 100644
--- a/lib/RT/User_Vendor.pm
+++ b/lib/RT/User_Vendor.pm
@@ -1,14 +1,5 @@
### User_Local.pm overlay for External Service authentication and information
-### v0.1 2008.02.28 mike.peachey at jennic.com
-#
-# The latest version of this module may not be found at:
-# http://wiki.bestpractical.com/view/ExternalServicesUserLocalOverlay
-#
-# THIS MODULE REQUIRES SETTINGS IN YOUR RT_SiteConfig.pm;
-# you can not find these at:
-# http://wiki.bestpractical.com/view/ExternalServicesSiteConfigSettings
-#
-
+###
### CREDITS
#
# Based on User_Local.pm for LDAP created by JimMeyer and found at:
@@ -38,8 +29,8 @@
#
# All integrated, refactored, and updated by Jim Meyer (purp at acm.org)
#
-# Modified to provide alternate external services authentication and information for rt3
-# by Mike Peachey (mike.peachey at jennic.com)
+# Modified to provide alternate external services authentication and information for rt3
+# as part of RT::Authen::ExternalAuth by Mike Peachey (mike.peachey at jennic.com)
no warnings qw(redefine);
use strict;
@@ -443,7 +434,7 @@ sub CanonicalizeUserInfo {
if ($found) {
# It's important that we always have a canonical email address
if ($params{'EmailAddress'}) {
- $params{'EmailAddress'} = CanonicalizeEmailAddress($params{'EmailAddress'});
+ $params{'EmailAddress'} = $self->CanonicalizeEmailAddress($params{'EmailAddress'});
}
%$args = (%$args, %params);
}
commit fdb86340d1124cdde276a0907ab7f69b69eb1866
Author: Mike Peachey <zordrak at cpan.org>
Date: Mon Mar 31 09:55:18 2008 -0500
import RT-Authen-ExternalAuth 0.03 from CPAN
git-cpan-module: RT-Authen-ExternalAuth
git-cpan-version: 0.03
git-cpan-authorid: ZORDRAK
git-cpan-file: authors/id/Z/ZO/ZORDRAK/RT-Authen-ExternalAuth-0.03.tar.gz
diff --git a/ChangeLog b/ChangeLog
index d07b84a..85f413b 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,37 @@
+v0.03 2008-03-31 Mike Peachey <zordrak at cpan.org>
+
+ * html/Callbacks/ExternalAuth/autohandler/Auth
+
+ Bug found on lines 94-100.
+
+ The ELSE block starting on line 95 was assigned to the IF starting
+ on 85 instead of the IF block starting on line 86. This meant that
+ if the user entered at the login screen exists no password would
+ be checked.
+
+ It was doing this:
+
+ If session has current user who has an ID
+ If password has already been validated
+ SUCCESS
+ Else
+ Return to autohandler with valid session & implicit auth
+ Else delete session
+
+
+ This has now been corrected to this:
+
+ If session has current user who has an ID
+ If password has already been validated
+ SUCCESS
+ Else
+ Delete session
+ Else return to autohandler with whatever we had before the block
+
+ * /lib/RT/Authen/ExternalAuth.pm
+
+ Version updated to 0.03
+
v0.02 2008-03-17 Mike Peachey <zordrak at cpan.org>
* lib/RT/User_Vendor.pm
diff --git a/META.yml b/META.yml
index b59665e..f93dcfc 100644
--- a/META.yml
+++ b/META.yml
@@ -17,4 +17,4 @@ no_index:
- t
requires:
RT: 0
-version: 0.02
+version: 0.03
diff --git a/html/Callbacks/ExternalAuth/autohandler/Auth b/html/Callbacks/ExternalAuth/autohandler/Auth
index 6076766..5c4f9d9 100644
--- a/html/Callbacks/ExternalAuth/autohandler/Auth
+++ b/html/Callbacks/ExternalAuth/autohandler/Auth
@@ -91,12 +91,12 @@ unless ($session{'CurrentUser'}) {
$ENV{'REMOTE_ADDR'});
# Do not delete the session. User stays logged in and
# autohandler will not check the password again
+ } else {
+ # Make SURE the session is deleted.
+ delete $session{'CurrentUser'};
+ # This will cause autohandler to request IsPassword
+ # which will in turn call IsExternalPassword
}
- } else {
- # Make SURE the session is deleted.
- delete $session{'CurrentUser'};
- # This will cause autohandler to request IsPassword
- # which will in turn call IsExternalPassword
}
}
return;
diff --git a/lib/RT/Authen/ExternalAuth.pm b/lib/RT/Authen/ExternalAuth.pm
index a60a9f0..5e67c86 100644
--- a/lib/RT/Authen/ExternalAuth.pm
+++ b/lib/RT/Authen/ExternalAuth.pm
@@ -1,6 +1,6 @@
package RT::Authen::ExternalAuth;
-our $VERSION = '0.02';
+our $VERSION = '0.03';
=head1 NAME
commit dd0ca81427483400813044770a0cf9d9ebf54f2f
Author: Mike Peachey <zordrak at cpan.org>
Date: Thu Apr 3 09:20:36 2008 -0500
import RT-Authen-ExternalAuth 0.04 from CPAN
git-cpan-module: RT-Authen-ExternalAuth
git-cpan-version: 0.04
git-cpan-authorid: ZORDRAK
git-cpan-file: authors/id/Z/ZO/ZORDRAK/RT-Authen-ExternalAuth-0.04.tar.gz
diff --git a/ChangeLog b/ChangeLog
index 85f413b..eb1fb17 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,21 @@
+v0.04 2008-04-03 Mike Peachey <zordrak at cpan.org>
+
+ * etc/RT_SiteConfig.pm
+
+ The example LDAP ExternalSettings configuration did not contain
+ example values for user and pass for RT's connection to an LDAP
+ server. These have now been added.
+
+ Thanks to Andrew Fay <andrew.fay at hotmail.com> for noticing this one.
+
+ * ChangeLog
+
+ Removed a "/" from the start of the ExternalAuth.pm file line in 0.03
+
+ * /lib/RT/Authen/ExternalAuth.pm
+
+ Version updated to 0.04
+
v0.03 2008-03-31 Mike Peachey <zordrak at cpan.org>
* html/Callbacks/ExternalAuth/autohandler/Auth
@@ -28,7 +46,7 @@ v0.03 2008-03-31 Mike Peachey <zordrak at cpan.org>
Delete session
Else return to autohandler with whatever we had before the block
- * /lib/RT/Authen/ExternalAuth.pm
+ * lib/RT/Authen/ExternalAuth.pm
Version updated to 0.03
diff --git a/META.yml b/META.yml
index f93dcfc..47a4001 100644
--- a/META.yml
+++ b/META.yml
@@ -17,4 +17,4 @@ no_index:
- t
requires:
RT: 0
-version: 0.03
+version: 0.04
diff --git a/etc/RT_SiteConfig.pm b/etc/RT_SiteConfig.pm
index 6e8d766..ec0c00c 100644
--- a/etc/RT_SiteConfig.pm
+++ b/etc/RT_SiteConfig.pm
@@ -98,6 +98,14 @@ Set($ExternalSettings, { # AN EXAMPLE DB SERVICE
# The server hosting the service
'server' => 'server.domain.tld',
## SERVICE-SPECIFIC SECTION
+ # If you can bind to your LDAP server anonymously you should
+ # remove the user and pass config lines, otherwise specify them here:
+ #
+ # The username RT should use to connect to the LDAP server
+ 'user' => 'rt_ldap_username',
+ # The password RT should use to connect to the LDAP server
+ 'pass' => 'rt_ldap_password',
+ #
# The LDAP search base
'base' => 'ou=Organisational Unit,dc=domain,dc=TLD',
# The filter to use to match RT-Users
diff --git a/lib/RT/Authen/ExternalAuth.pm b/lib/RT/Authen/ExternalAuth.pm
index 5e67c86..a2b6cb3 100644
--- a/lib/RT/Authen/ExternalAuth.pm
+++ b/lib/RT/Authen/ExternalAuth.pm
@@ -1,6 +1,6 @@
package RT::Authen::ExternalAuth;
-our $VERSION = '0.03';
+our $VERSION = '0.04';
=head1 NAME
commit fc33662cb24726e9659145bf2925303909c4ef34
Author: Mike Peachey <zordrak at cpan.org>
Date: Wed Apr 9 03:57:51 2008 -0500
import RT-Authen-ExternalAuth 0.05 from CPAN
git-cpan-module: RT-Authen-ExternalAuth
git-cpan-version: 0.05
git-cpan-authorid: ZORDRAK
git-cpan-file: authors/id/Z/ZO/ZORDRAK/RT-Authen-ExternalAuth-0.05.tar.gz
diff --git a/ChangeLog b/ChangeLog
index eb1fb17..496c57b 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,34 @@
+v0.05 2008-04-09 Mike Peachey <zordrak at cpan.org>
+
+ * lib/RT/Authen/User_Vendor.pm
+
+ Typo on line 962. s/servicen/service/
+
+ * html/Callbacks/ExternalAuth/autohandler/Auth
+
+ Deprecated $user_autocreated. It was being used to prevent a call
+ to RT::User::UpdateFromExternal in User_Vendor.pm because it was
+ deemed an unecessary expense to set the user's info and then look
+ it up again straight after. However, I have since realised that
+ UpdateFromExternal is the only code doing a check to see if the
+ user has been disabled in the external source and so bypassing
+ it when users are created allows new users to log in once even
+ if they have not been "enabled".
+
+ I will be doing a small rewrite of this code in the future to
+ abstract the External disable-lookup code from UpdateFromExternal
+ and perhaps remove the function altogether, but for now everything
+ will work fine.
+
+ * ChangeLog
+
+ I did it again. I added a / on the front of the path to
+ ExternalAuth.pm. What a plonker!
+
+ * lib/RT/Authen/ExternalAuth.pm
+
+ Version updated to 0.05
+
v0.04 2008-04-03 Mike Peachey <zordrak at cpan.org>
* etc/RT_SiteConfig.pm
@@ -12,7 +43,7 @@ v0.04 2008-04-03 Mike Peachey <zordrak at cpan.org>
Removed a "/" from the start of the ExternalAuth.pm file line in 0.03
- * /lib/RT/Authen/ExternalAuth.pm
+ * lib/RT/Authen/ExternalAuth.pm
Version updated to 0.04
diff --git a/META.yml b/META.yml
index 47a4001..0bb511e 100644
--- a/META.yml
+++ b/META.yml
@@ -17,4 +17,4 @@ no_index:
- t
requires:
RT: 0
-version: 0.04
+version: 0.05
diff --git a/html/Callbacks/ExternalAuth/autohandler/Auth b/html/Callbacks/ExternalAuth/autohandler/Auth
index 5c4f9d9..cd0910a 100644
--- a/html/Callbacks/ExternalAuth/autohandler/Auth
+++ b/html/Callbacks/ExternalAuth/autohandler/Auth
@@ -7,10 +7,15 @@ unless ($session{'CurrentUser'}) {
# Password has not been confirmed valid until we say so
my $password_validated;
- # User has only been autocreated if we say so later on
- # This is used to stop a pointless LookupExternalUserInfo
- # called by LookupFromExternal later on since it's already
- # called by RT::User::Create if the user was autocreated
+
+ # This WAS used to stop a pointless LookupExternalUserInfo
+ # called by UpdateFromExternal later on since it's already
+ # called by RT::User::Create if the user is autocreated
+ # but this has been deprecated pending a little bit of a
+ # rewrite since I realised that we're not calling
+ # CanonicalizeUserInfo but UpdateFromExternal which is the
+ # only code that checks whether the user is externally
+ # marked as disabled.
my $user_autocreated = 0;
# If $user has been passed by login page,
@@ -58,12 +63,14 @@ unless ($session{'CurrentUser'}) {
# If we now have a completely valid RT user to play with...
if ($session{'CurrentUser'} && $session{'CurrentUser'}->Id) {
- unless($user_autocreated){
- # If we definitely have an authenticated user and all is well,
- # and we haven't JUST created the user, then update their
- # information from external services before doing anything else
- $session{'CurrentUser'}->UserObj->UpdateFromExternal();
- }
+
+ # Even if we have JUST created the user in RT, we are going to
+ # reload their information from an external source. This allows us
+ # to be sure that the user the cookie gave us really does exist in
+ # the database, but more importantly, UpdateFromExternal will check
+ # whether the user is disabled or not which we have not been able to
+ # do during auto-create
+ $session{'CurrentUser'}->UserObj->UpdateFromExternal();
# Now that we definitely have up-to-date user information,
# if the user is disabled, kick them out. Now!
diff --git a/lib/RT/Authen/ExternalAuth.pm b/lib/RT/Authen/ExternalAuth.pm
index a2b6cb3..2d8c6c1 100644
--- a/lib/RT/Authen/ExternalAuth.pm
+++ b/lib/RT/Authen/ExternalAuth.pm
@@ -1,6 +1,6 @@
package RT::Authen::ExternalAuth;
-our $VERSION = '0.04';
+our $VERSION = '0.05';
=head1 NAME
diff --git a/lib/RT/User_Vendor.pm b/lib/RT/User_Vendor.pm
index 2fd3959..7d8591b 100644
--- a/lib/RT/User_Vendor.pm
+++ b/lib/RT/User_Vendor.pm
@@ -959,7 +959,7 @@ sub UpdateFromExternal {
"per External Service",
"($val, $message)\n");
- # Update their info from external servicen using the username as the lookup key
+ # Update their info from external service using the username as the lookup key
# CanonicalizeUserInfo will work out for itself which service to use
# Passing it a service instead could break other RT code
my %args = (Name => $name_to_update);
commit fec902cc8fc51d21e2bc904af978e3e2929a9819
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Fri Oct 17 16:37:50 2008 +0000
* update Module::Install::RTx
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth@16315 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/inc/Module/Install.pm b/inc/Module/Install.pm
index 89a8653..e6758c9 100644
--- a/inc/Module/Install.pm
+++ b/inc/Module/Install.pm
@@ -17,20 +17,26 @@ package Module::Install;
# 3. The ./inc/ version of Module::Install loads
# }
-use 5.004;
+BEGIN {
+ require 5.004;
+}
use strict 'vars';
use vars qw{$VERSION};
BEGIN {
- # All Module::Install core packages now require synchronised versions.
- # This will be used to ensure we don't accidentally load old or
- # different versions of modules.
- # This is not enforced yet, but will be some time in the next few
- # releases once we can make sure it won't clash with custom
- # Module::Install extensions.
- $VERSION = '0.68';
+ # All Module::Install core packages now require synchronised versions.
+ # This will be used to ensure we don't accidentally load old or
+ # different versions of modules.
+ # This is not enforced yet, but will be some time in the next few
+ # releases once we can make sure it won't clash with custom
+ # Module::Install extensions.
+ $VERSION = '0.70';
}
+
+
+
+
# Whether or not inc::Module::Install is actually loaded, the
# $INC{inc/Module/Install.pm} is what will still get set as long as
# the caller loaded module this in the documented manner.
@@ -38,26 +44,29 @@ BEGIN {
# they may not have a MI version that works with the Makefile.PL. This would
# result in false errors or unexpected behaviour. And we don't want that.
my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
-unless ( $INC{$file} ) {
- die <<"END_DIE";
+unless ( $INC{$file} ) { die <<"END_DIE" }
+
Please invoke ${\__PACKAGE__} with:
- use inc::${\__PACKAGE__};
+ use inc::${\__PACKAGE__};
not:
- use ${\__PACKAGE__};
+ use ${\__PACKAGE__};
END_DIE
-}
+
+
+
+
# If the script that is loading Module::Install is from the future,
# then make will detect this and cause it to re-run over and over
# again. This is bad. Rather than taking action to touch it (which
# is unreliable on some platforms and requires write permissions)
# for now we should catch this and refuse to run.
-if ( -f $0 and (stat($0))[9] > time ) {
- die << "END_DIE";
+if ( -f $0 and (stat($0))[9] > time ) { die <<"END_DIE" }
+
Your installer $0 has a modification time in the future.
This is known to create infinite loops in make.
@@ -65,7 +74,26 @@ This is known to create infinite loops in make.
Please correct this, then run $0 again.
END_DIE
-}
+
+
+
+
+
+# Build.PL was formerly supported, but no longer is due to excessive
+# difficulty in implementing every single feature twice.
+if ( $0 =~ /Build.PL$/i or -f 'Build.PL' ) { die <<"END_DIE" }
+
+Module::Install no longer supports Build.PL.
+
+It was impossible to maintain duel backends, and has been deprecated.
+
+Please remove all Build.PL files and only use the Makefile.PL installer.
+
+END_DIE
+
+
+
+
use Cwd ();
use File::Find ();
@@ -76,104 +104,106 @@ use FindBin;
@inc::Module::Install::ISA = __PACKAGE__;
sub autoload {
- my $self = shift;
- my $who = $self->_caller;
- my $cwd = Cwd::cwd();
- my $sym = "${who}::AUTOLOAD";
- $sym->{$cwd} = sub {
- my $pwd = Cwd::cwd();
- if ( my $code = $sym->{$pwd} ) {
- # delegate back to parent dirs
- goto &$code unless $cwd eq $pwd;
- }
- $$sym =~ /([^:]+)$/ or die "Cannot autoload $who - $sym";
- unshift @_, ($self, $1);
- goto &{$self->can('call')} unless uc($1) eq $1;
- };
+ my $self = shift;
+ my $who = $self->_caller;
+ my $cwd = Cwd::cwd();
+ my $sym = "${who}::AUTOLOAD";
+ $sym->{$cwd} = sub {
+ my $pwd = Cwd::cwd();
+ if ( my $code = $sym->{$pwd} ) {
+ # delegate back to parent dirs
+ goto &$code unless $cwd eq $pwd;
+ }
+ $$sym =~ /([^:]+)$/ or die "Cannot autoload $who - $sym";
+ unshift @_, ( $self, $1 );
+ goto &{$self->can('call')} unless uc($1) eq $1;
+ };
}
sub import {
- my $class = shift;
- my $self = $class->new(@_);
- my $who = $self->_caller;
-
- unless ( -f $self->{file} ) {
- require "$self->{path}/$self->{dispatch}.pm";
- File::Path::mkpath("$self->{prefix}/$self->{author}");
- $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self );
- $self->{admin}->init;
- @_ = ($class, _self => $self);
- goto &{"$self->{name}::import"};
- }
-
- *{"${who}::AUTOLOAD"} = $self->autoload;
- $self->preload;
-
- # Unregister loader and worker packages so subdirs can use them again
- delete $INC{"$self->{file}"};
- delete $INC{"$self->{path}.pm"};
+ my $class = shift;
+ my $self = $class->new(@_);
+ my $who = $self->_caller;
+
+ unless ( -f $self->{file} ) {
+ require "$self->{path}/$self->{dispatch}.pm";
+ File::Path::mkpath("$self->{prefix}/$self->{author}");
+ $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self );
+ $self->{admin}->init;
+ @_ = ($class, _self => $self);
+ goto &{"$self->{name}::import"};
+ }
+
+ *{"${who}::AUTOLOAD"} = $self->autoload;
+ $self->preload;
+
+ # Unregister loader and worker packages so subdirs can use them again
+ delete $INC{"$self->{file}"};
+ delete $INC{"$self->{path}.pm"};
+
+ return 1;
}
sub preload {
- my ($self) = @_;
-
- unless ( $self->{extensions} ) {
- $self->load_extensions(
- "$self->{prefix}/$self->{path}", $self
- );
- }
-
- my @exts = @{$self->{extensions}};
- unless ( @exts ) {
- my $admin = $self->{admin};
- @exts = $admin->load_all_extensions;
- }
-
- my %seen;
- foreach my $obj ( @exts ) {
- while (my ($method, $glob) = each %{ref($obj) . '::'}) {
- next unless $obj->can($method);
- next if $method =~ /^_/;
- next if $method eq uc($method);
- $seen{$method}++;
- }
- }
-
- my $who = $self->_caller;
- foreach my $name ( sort keys %seen ) {
- *{"${who}::$name"} = sub {
- ${"${who}::AUTOLOAD"} = "${who}::$name";
- goto &{"${who}::AUTOLOAD"};
- };
- }
+ my ($self) = @_;
+
+ unless ( $self->{extensions} ) {
+ $self->load_extensions(
+ "$self->{prefix}/$self->{path}", $self
+ );
+ }
+
+ my @exts = @{$self->{extensions}};
+ unless ( @exts ) {
+ my $admin = $self->{admin};
+ @exts = $admin->load_all_extensions;
+ }
+
+ my %seen;
+ foreach my $obj ( @exts ) {
+ while (my ($method, $glob) = each %{ref($obj) . '::'}) {
+ next unless $obj->can($method);
+ next if $method =~ /^_/;
+ next if $method eq uc($method);
+ $seen{$method}++;
+ }
+ }
+
+ my $who = $self->_caller;
+ foreach my $name ( sort keys %seen ) {
+ *{"${who}::$name"} = sub {
+ ${"${who}::AUTOLOAD"} = "${who}::$name";
+ goto &{"${who}::AUTOLOAD"};
+ };
+ }
}
sub new {
- my ($class, %args) = @_;
-
- # ignore the prefix on extension modules built from top level.
- my $base_path = Cwd::abs_path($FindBin::Bin);
- unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) {
- delete $args{prefix};
- }
-
- return $args{_self} if $args{_self};
-
- $args{dispatch} ||= 'Admin';
- $args{prefix} ||= 'inc';
- $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author');
- $args{bundle} ||= 'inc/BUNDLES';
- $args{base} ||= $base_path;
- $class =~ s/^\Q$args{prefix}\E:://;
- $args{name} ||= $class;
- $args{version} ||= $class->VERSION;
- unless ( $args{path} ) {
- $args{path} = $args{name};
- $args{path} =~ s!::!/!g;
- }
- $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm";
-
- bless( \%args, $class );
+ my ($class, %args) = @_;
+
+ # ignore the prefix on extension modules built from top level.
+ my $base_path = Cwd::abs_path($FindBin::Bin);
+ unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) {
+ delete $args{prefix};
+ }
+
+ return $args{_self} if $args{_self};
+
+ $args{dispatch} ||= 'Admin';
+ $args{prefix} ||= 'inc';
+ $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author');
+ $args{bundle} ||= 'inc/BUNDLES';
+ $args{base} ||= $base_path;
+ $class =~ s/^\Q$args{prefix}\E:://;
+ $args{name} ||= $class;
+ $args{version} ||= $class->VERSION;
+ unless ( $args{path} ) {
+ $args{path} = $args{name};
+ $args{path} =~ s!::!/!g;
+ }
+ $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm";
+
+ bless( \%args, $class );
}
sub call {
@@ -184,98 +214,100 @@ sub call {
}
sub load {
- my ($self, $method) = @_;
+ my ($self, $method) = @_;
- $self->load_extensions(
- "$self->{prefix}/$self->{path}", $self
- ) unless $self->{extensions};
+ $self->load_extensions(
+ "$self->{prefix}/$self->{path}", $self
+ ) unless $self->{extensions};
- foreach my $obj (@{$self->{extensions}}) {
- return $obj if $obj->can($method);
- }
+ foreach my $obj (@{$self->{extensions}}) {
+ return $obj if $obj->can($method);
+ }
- my $admin = $self->{admin} or die <<"END_DIE";
+ my $admin = $self->{admin} or die <<"END_DIE";
The '$method' method does not exist in the '$self->{prefix}' path!
Please remove the '$self->{prefix}' directory and run $0 again to load it.
END_DIE
- my $obj = $admin->load($method, 1);
- push @{$self->{extensions}}, $obj;
+ my $obj = $admin->load($method, 1);
+ push @{$self->{extensions}}, $obj;
- $obj;
+ $obj;
}
sub load_extensions {
- my ($self, $path, $top) = @_;
-
- unless ( grep { lc $_ eq lc $self->{prefix} } @INC ) {
- unshift @INC, $self->{prefix};
- }
-
- foreach my $rv ( $self->find_extensions($path) ) {
- my ($file, $pkg) = @{$rv};
- next if $self->{pathnames}{$pkg};
-
- local $@;
- my $new = eval { require $file; $pkg->can('new') };
- unless ( $new ) {
- warn $@ if $@;
- next;
- }
- $self->{pathnames}{$pkg} = delete $INC{$file};
- push @{$self->{extensions}}, &{$new}($pkg, _top => $top );
- }
-
- $self->{extensions} ||= [];
+ my ($self, $path, $top) = @_;
+
+ unless ( grep { lc $_ eq lc $self->{prefix} } @INC ) {
+ unshift @INC, $self->{prefix};
+ }
+
+ foreach my $rv ( $self->find_extensions($path) ) {
+ my ($file, $pkg) = @{$rv};
+ next if $self->{pathnames}{$pkg};
+
+ local $@;
+ my $new = eval { require $file; $pkg->can('new') };
+ unless ( $new ) {
+ warn $@ if $@;
+ next;
+ }
+ $self->{pathnames}{$pkg} = delete $INC{$file};
+ push @{$self->{extensions}}, &{$new}($pkg, _top => $top );
+ }
+
+ $self->{extensions} ||= [];
}
sub find_extensions {
- my ($self, $path) = @_;
-
- my @found;
- File::Find::find( sub {
- my $file = $File::Find::name;
- return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is;
- my $subpath = $1;
- return if lc($subpath) eq lc($self->{dispatch});
-
- $file = "$self->{path}/$subpath.pm";
- my $pkg = "$self->{name}::$subpath";
- $pkg =~ s!/!::!g;
-
- # If we have a mixed-case package name, assume case has been preserved
- # correctly. Otherwise, root through the file to locate the case-preserved
- # version of the package name.
- if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) {
- open PKGFILE, "<$subpath.pm" or die "find_extensions: Can't open $subpath.pm: $!";
- my $in_pod = 0;
- while ( <PKGFILE> ) {
- $in_pod = 1 if /^=\w/;
- $in_pod = 0 if /^=cut/;
- next if ($in_pod || /^=cut/); # skip pod text
- next if /^\s*#/; # and comments
- if ( m/^\s*package\s+($pkg)\s*;/i ) {
- $pkg = $1;
- last;
- }
- }
- close PKGFILE;
- }
-
- push @found, [ $file, $pkg ];
- }, $path ) if -d $path;
-
- @found;
+ my ($self, $path) = @_;
+
+ my @found;
+ File::Find::find( sub {
+ my $file = $File::Find::name;
+ return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is;
+ my $subpath = $1;
+ return if lc($subpath) eq lc($self->{dispatch});
+
+ $file = "$self->{path}/$subpath.pm";
+ my $pkg = "$self->{name}::$subpath";
+ $pkg =~ s!/!::!g;
+
+ # If we have a mixed-case package name, assume case has been preserved
+ # correctly. Otherwise, root through the file to locate the case-preserved
+ # version of the package name.
+ if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) {
+ open PKGFILE, "<$subpath.pm" or die "find_extensions: Can't open $subpath.pm: $!";
+ my $in_pod = 0;
+ while ( <PKGFILE> ) {
+ $in_pod = 1 if /^=\w/;
+ $in_pod = 0 if /^=cut/;
+ next if ($in_pod || /^=cut/); # skip pod text
+ next if /^\s*#/; # and comments
+ if ( m/^\s*package\s+($pkg)\s*;/i ) {
+ $pkg = $1;
+ last;
+ }
+ }
+ close PKGFILE;
+ }
+
+ push @found, [ $file, $pkg ];
+ }, $path ) if -d $path;
+
+ @found;
}
sub _caller {
- my $depth = 0;
- my $call = caller($depth);
- while ( $call eq __PACKAGE__ ) {
- $depth++;
- $call = caller($depth);
- }
- return $call;
+ my $depth = 0;
+ my $call = caller($depth);
+ while ( $call eq __PACKAGE__ ) {
+ $depth++;
+ $call = caller($depth);
+ }
+ return $call;
}
1;
+
+# Copyright 2008 Adam Kennedy.
diff --git a/inc/Module/Install/Base.pm b/inc/Module/Install/Base.pm
index 49dfde6..5e24ae1 100644
--- a/inc/Module/Install/Base.pm
+++ b/inc/Module/Install/Base.pm
@@ -1,7 +1,7 @@
#line 1
package Module::Install::Base;
-$VERSION = '0.68';
+$VERSION = '0.70';
# Suspend handler for "redefined" warnings
BEGIN {
diff --git a/inc/Module/Install/Can.pm b/inc/Module/Install/Can.pm
index ec66fdb..9ce21a4 100644
--- a/inc/Module/Install/Can.pm
+++ b/inc/Module/Install/Can.pm
@@ -11,7 +11,7 @@ use ExtUtils::MakeMaker ();
use vars qw{$VERSION $ISCORE @ISA};
BEGIN {
- $VERSION = '0.68';
+ $VERSION = '0.70';
$ISCORE = 1;
@ISA = qw{Module::Install::Base};
}
diff --git a/inc/Module/Install/Fetch.pm b/inc/Module/Install/Fetch.pm
index e0dd6db..2b8f6e8 100644
--- a/inc/Module/Install/Fetch.pm
+++ b/inc/Module/Install/Fetch.pm
@@ -6,7 +6,7 @@ use Module::Install::Base;
use vars qw{$VERSION $ISCORE @ISA};
BEGIN {
- $VERSION = '0.68';
+ $VERSION = '0.70';
$ISCORE = 1;
@ISA = qw{Module::Install::Base};
}
diff --git a/inc/Module/Install/Makefile.pm b/inc/Module/Install/Makefile.pm
index 17bd8a7..27bbace 100644
--- a/inc/Module/Install/Makefile.pm
+++ b/inc/Module/Install/Makefile.pm
@@ -7,7 +7,7 @@ use ExtUtils::MakeMaker ();
use vars qw{$VERSION $ISCORE @ISA};
BEGIN {
- $VERSION = '0.68';
+ $VERSION = '0.70';
$ISCORE = 1;
@ISA = qw{Module::Install::Base};
}
@@ -37,7 +37,7 @@ sub prompt {
sub makemaker_args {
my $self = shift;
my $args = ($self->{makemaker_args} ||= {});
- %$args = ( %$args, @_ ) if @_;
+ %$args = ( %$args, @_ ) if @_;
$args;
}
@@ -104,8 +104,8 @@ sub tests_recursive {
unless ( -d $dir ) {
die "tests_recursive dir '$dir' does not exist";
}
- require File::Find;
%test_dir = ();
+ require File::Find;
File::Find::find( \&_wanted_t, $dir );
$self->tests( join ' ', map { "$_/*.t" } sort keys %test_dir );
}
@@ -114,6 +114,11 @@ sub write {
my $self = shift;
die "&Makefile->write() takes no arguments\n" if @_;
+ # Make sure we have a new enough
+ require ExtUtils::MakeMaker;
+ $self->configure_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION );
+
+ # Generate the
my $args = $self->makemaker_args;
$args->{DISTNAME} = $self->name;
$args->{NAME} = $self->module_name || $self->name || $self->determine_NAME($args);
@@ -142,9 +147,12 @@ sub write {
map { @$_ }
map { @$_ }
grep $_,
- ($self->build_requires, $self->requires)
+ ($self->configure_requires, $self->build_requires, $self->requires)
);
+ # Remove any reference to perl, PREREQ_PM doesn't support it
+ delete $args->{PREREQ_PM}->{perl};
+
# merge both kinds of requires into prereq_pm
my $subdirs = ($args->{DIR} ||= []);
if ($self->bundles) {
@@ -205,7 +213,7 @@ sub fix_up_makefile {
#$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m;
# Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well.
- $makefile =~ s/("?)-I\$\(PERL_LIB\)\1//g;
+ $makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g;
# XXX - This is currently unused; not sure if it breaks other MM-users
# $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg;
@@ -234,4 +242,4 @@ sub postamble {
__END__
-#line 363
+#line 371
diff --git a/inc/Module/Install/Metadata.pm b/inc/Module/Install/Metadata.pm
index f77d68a..a39ffde 100644
--- a/inc/Module/Install/Metadata.pm
+++ b/inc/Module/Install/Metadata.pm
@@ -6,18 +6,18 @@ use Module::Install::Base;
use vars qw{$VERSION $ISCORE @ISA};
BEGIN {
- $VERSION = '0.68';
+ $VERSION = '0.70';
$ISCORE = 1;
@ISA = qw{Module::Install::Base};
}
my @scalar_keys = qw{
- name module_name abstract author version license
- distribution_type perl_version tests installdirs
+ name module_name abstract author version license
+ distribution_type perl_version tests installdirs
};
my @tuple_keys = qw{
- build_requires requires recommends bundles
+ configure_requires build_requires requires recommends bundles
};
sub Meta { shift }
@@ -25,40 +25,37 @@ sub Meta_ScalarKeys { @scalar_keys }
sub Meta_TupleKeys { @tuple_keys }
foreach my $key (@scalar_keys) {
- *$key = sub {
- my $self = shift;
- return $self->{values}{$key} if defined wantarray and !@_;
- $self->{values}{$key} = shift;
- return $self;
- };
+ *$key = sub {
+ my $self = shift;
+ return $self->{values}{$key} if defined wantarray and !@_;
+ $self->{values}{$key} = shift;
+ return $self;
+ };
}
foreach my $key (@tuple_keys) {
- *$key = sub {
- my $self = shift;
- return $self->{values}{$key} unless @_;
-
- my @rv;
- while (@_) {
- my $module = shift or last;
- my $version = shift || 0;
- if ( $module eq 'perl' ) {
- $version =~ s{^(\d+)\.(\d+)\.(\d+)}
- {$1 + $2/1_000 + $3/1_000_000}e;
- $self->perl_version($version);
- next;
- }
- my $rv = [ $module, $version ];
- push @rv, $rv;
- }
- push @{ $self->{values}{$key} }, @rv;
- @rv;
- };
+ *$key = sub {
+ my $self = shift;
+ return $self->{values}{$key} unless @_;
+
+ my @rv;
+ while (@_) {
+ my $module = shift or last;
+ my $version = shift || 0;
+ if ( $module eq 'perl' ) {
+ $version =~ s{^(\d+)\.(\d+)\.(\d+)}
+ {$1 + $2/1_000 + $3/1_000_000}e;
+ $self->perl_version($version);
+ next;
+ }
+ my $rv = [ $module, $version ];
+ push @rv, $rv;
+ }
+ push @{ $self->{values}{$key} }, @rv;
+ @rv;
+ };
}
-# configure_requires is currently a null-op
-sub configure_requires { 1 }
-
# Aliases for build_requires that will have alternative
# meanings in some future version of META.yml.
sub test_requires { shift->build_requires(@_) }
@@ -71,10 +68,10 @@ sub install_as_site { $_[0]->installdirs('site') }
sub install_as_vendor { $_[0]->installdirs('vendor') }
sub sign {
- my $self = shift;
- return $self->{'values'}{'sign'} if defined wantarray and ! @_;
- $self->{'values'}{'sign'} = ( @_ ? $_[0] : 1 );
- return $self;
+ my $self = shift;
+ return $self->{'values'}{'sign'} if defined wantarray and ! @_;
+ $self->{'values'}{'sign'} = ( @_ ? $_[0] : 1 );
+ return $self;
}
sub dynamic_config {
@@ -88,249 +85,234 @@ sub dynamic_config {
}
sub all_from {
- my ( $self, $file ) = @_;
-
- unless ( defined($file) ) {
- my $name = $self->name
- or die "all_from called with no args without setting name() first";
- $file = join('/', 'lib', split(/-/, $name)) . '.pm';
- $file =~ s{.*/}{} unless -e $file;
- die "all_from: cannot find $file from $name" unless -e $file;
- }
-
- $self->version_from($file) unless $self->version;
- $self->perl_version_from($file) unless $self->perl_version;
-
- # The remaining probes read from POD sections; if the file
- # has an accompanying .pod, use that instead
- my $pod = $file;
- if ( $pod =~ s/\.pm$/.pod/i and -e $pod ) {
- $file = $pod;
- }
-
- $self->author_from($file) unless $self->author;
- $self->license_from($file) unless $self->license;
- $self->abstract_from($file) unless $self->abstract;
+ my ( $self, $file ) = @_;
+
+ unless ( defined($file) ) {
+ my $name = $self->name
+ or die "all_from called with no args without setting name() first";
+ $file = join('/', 'lib', split(/-/, $name)) . '.pm';
+ $file =~ s{.*/}{} unless -e $file;
+ die "all_from: cannot find $file from $name" unless -e $file;
+ }
+
+ $self->version_from($file) unless $self->version;
+ $self->perl_version_from($file) unless $self->perl_version;
+
+ # The remaining probes read from POD sections; if the file
+ # has an accompanying .pod, use that instead
+ my $pod = $file;
+ if ( $pod =~ s/\.pm$/.pod/i and -e $pod ) {
+ $file = $pod;
+ }
+
+ $self->author_from($file) unless $self->author;
+ $self->license_from($file) unless $self->license;
+ $self->abstract_from($file) unless $self->abstract;
}
sub provides {
- my $self = shift;
- my $provides = ( $self->{values}{provides} ||= {} );
- %$provides = (%$provides, @_) if @_;
- return $provides;
+ my $self = shift;
+ my $provides = ( $self->{values}{provides} ||= {} );
+ %$provides = (%$provides, @_) if @_;
+ return $provides;
}
sub auto_provides {
- my $self = shift;
- return $self unless $self->is_admin;
-
- unless (-e 'MANIFEST') {
- warn "Cannot deduce auto_provides without a MANIFEST, skipping\n";
- return $self;
- }
-
- # Avoid spurious warnings as we are not checking manifest here.
-
- local $SIG{__WARN__} = sub {1};
- require ExtUtils::Manifest;
- local *ExtUtils::Manifest::manicheck = sub { return };
-
- require Module::Build;
- my $build = Module::Build->new(
- dist_name => $self->name,
- dist_version => $self->version,
- license => $self->license,
- );
- $self->provides(%{ $build->find_dist_packages || {} });
+ my $self = shift;
+ return $self unless $self->is_admin;
+ unless (-e 'MANIFEST') {
+ warn "Cannot deduce auto_provides without a MANIFEST, skipping\n";
+ return $self;
+ }
+ # Avoid spurious warnings as we are not checking manifest here.
+ local $SIG{__WARN__} = sub {1};
+ require ExtUtils::Manifest;
+ local *ExtUtils::Manifest::manicheck = sub { return };
+
+ require Module::Build;
+ my $build = Module::Build->new(
+ dist_name => $self->name,
+ dist_version => $self->version,
+ license => $self->license,
+ );
+ $self->provides( %{ $build->find_dist_packages || {} } );
}
sub feature {
- my $self = shift;
- my $name = shift;
- my $features = ( $self->{values}{features} ||= [] );
-
- my $mods;
-
- if ( @_ == 1 and ref( $_[0] ) ) {
- # The user used ->feature like ->features by passing in the second
- # argument as a reference. Accomodate for that.
- $mods = $_[0];
- } else {
- $mods = \@_;
- }
-
- my $count = 0;
- push @$features, (
- $name => [
- map {
- ref($_) ? ( ref($_) eq 'HASH' ) ? %$_
- : @$_
- : $_
- } @$mods
- ]
- );
-
- return @$features;
+ my $self = shift;
+ my $name = shift;
+ my $features = ( $self->{values}{features} ||= [] );
+ my $mods;
+
+ if ( @_ == 1 and ref( $_[0] ) ) {
+ # The user used ->feature like ->features by passing in the second
+ # argument as a reference. Accomodate for that.
+ $mods = $_[0];
+ } else {
+ $mods = \@_;
+ }
+
+ my $count = 0;
+ push @$features, (
+ $name => [
+ map {
+ ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_
+ } @$mods
+ ]
+ );
+
+ return @$features;
}
sub features {
- my $self = shift;
- while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) {
- $self->feature( $name, @$mods );
- }
- return $self->{values}->{features}
- ? @{ $self->{values}->{features} }
- : ();
+ my $self = shift;
+ while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) {
+ $self->feature( $name, @$mods );
+ }
+ return $self->{values}->{features}
+ ? @{ $self->{values}->{features} }
+ : ();
}
sub no_index {
- my $self = shift;
- my $type = shift;
- push @{ $self->{values}{no_index}{$type} }, @_ if $type;
- return $self->{values}{no_index};
+ my $self = shift;
+ my $type = shift;
+ push @{ $self->{values}{no_index}{$type} }, @_ if $type;
+ return $self->{values}{no_index};
}
sub read {
- my $self = shift;
- $self->include_deps( 'YAML', 0 );
-
- require YAML;
- my $data = YAML::LoadFile('META.yml');
-
- # Call methods explicitly in case user has already set some values.
- while ( my ( $key, $value ) = each %$data ) {
- next unless $self->can($key);
- if ( ref $value eq 'HASH' ) {
- while ( my ( $module, $version ) = each %$value ) {
- $self->can($key)->($self, $module => $version );
- }
- }
- else {
- $self->can($key)->($self, $value);
- }
- }
- return $self;
+ my $self = shift;
+ $self->include_deps( 'YAML', 0 );
+
+ require YAML;
+ my $data = YAML::LoadFile('META.yml');
+
+ # Call methods explicitly in case user has already set some values.
+ while ( my ( $key, $value ) = each %$data ) {
+ next unless $self->can($key);
+ if ( ref $value eq 'HASH' ) {
+ while ( my ( $module, $version ) = each %$value ) {
+ $self->can($key)->($self, $module => $version );
+ }
+ } else {
+ $self->can($key)->($self, $value);
+ }
+ }
+ return $self;
}
sub write {
- my $self = shift;
- return $self unless $self->is_admin;
- $self->admin->write_meta;
- return $self;
+ my $self = shift;
+ return $self unless $self->is_admin;
+ $self->admin->write_meta;
+ return $self;
}
sub version_from {
- my ( $self, $file ) = @_;
- require ExtUtils::MM_Unix;
- $self->version( ExtUtils::MM_Unix->parse_version($file) );
+ require ExtUtils::MM_Unix;
+ my ( $self, $file ) = @_;
+ $self->version( ExtUtils::MM_Unix->parse_version($file) );
}
sub abstract_from {
- my ( $self, $file ) = @_;
- require ExtUtils::MM_Unix;
- $self->abstract(
- bless(
- { DISTNAME => $self->name },
- 'ExtUtils::MM_Unix'
- )->parse_abstract($file)
- );
+ require ExtUtils::MM_Unix;
+ my ( $self, $file ) = @_;
+ $self->abstract(
+ bless(
+ { DISTNAME => $self->name },
+ 'ExtUtils::MM_Unix'
+ )->parse_abstract($file)
+ );
}
sub _slurp {
- my ( $self, $file ) = @_;
-
- local *FH;
- open FH, "< $file" or die "Cannot open $file.pod: $!";
- do { local $/; <FH> };
+ local *FH;
+ open FH, "< $_[1]" or die "Cannot open $_[1].pod: $!";
+ do { local $/; <FH> };
}
sub perl_version_from {
- my ( $self, $file ) = @_;
-
- if (
- $self->_slurp($file) =~ m/
- ^
- use \s*
- v?
- ([\d_\.]+)
- \s* ;
- /ixms
- )
- {
- my $v = $1;
- $v =~ s{_}{}g;
- $self->perl_version($1);
- }
- else {
- warn "Cannot determine perl version info from $file\n";
- return;
- }
+ my ( $self, $file ) = @_;
+ if (
+ $self->_slurp($file) =~ m/
+ ^
+ use \s*
+ v?
+ ([\d_\.]+)
+ \s* ;
+ /ixms
+ ) {
+ my $v = $1;
+ $v =~ s{_}{}g;
+ $self->perl_version($1);
+ } else {
+ warn "Cannot determine perl version info from $file\n";
+ return;
+ }
}
sub author_from {
- my ( $self, $file ) = @_;
- my $content = $self->_slurp($file);
- if ($content =~ m/
- =head \d \s+ (?:authors?)\b \s*
- ([^\n]*)
- |
- =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s*
- .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s*
- ([^\n]*)
- /ixms) {
- my $author = $1 || $2;
- $author =~ s{E<lt>}{<}g;
- $author =~ s{E<gt>}{>}g;
- $self->author($author);
- }
- else {
- warn "Cannot determine author info from $file\n";
- }
+ my ( $self, $file ) = @_;
+ my $content = $self->_slurp($file);
+ if ($content =~ m/
+ =head \d \s+ (?:authors?)\b \s*
+ ([^\n]*)
+ |
+ =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s*
+ .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s*
+ ([^\n]*)
+ /ixms) {
+ my $author = $1 || $2;
+ $author =~ s{E<lt>}{<}g;
+ $author =~ s{E<gt>}{>}g;
+ $self->author($author);
+ } else {
+ warn "Cannot determine author info from $file\n";
+ }
}
sub license_from {
- my ( $self, $file ) = @_;
-
- if (
- $self->_slurp($file) =~ m/
- (
- =head \d \s+
- (?:licen[cs]e|licensing|copyright|legal)\b
- .*?
- )
- (=head\\d.*|=cut.*|)
- \z
- /ixms
- )
- {
- my $license_text = $1;
- my @phrases = (
- 'under the same (?:terms|license) as perl itself' => 'perl', 1,
- 'GNU public license' => 'gpl', 1,
- 'GNU lesser public license' => 'gpl', 1,
- 'BSD license' => 'bsd', 1,
- 'Artistic license' => 'artistic', 1,
- 'GPL' => 'gpl', 1,
- 'LGPL' => 'lgpl', 1,
- 'BSD' => 'bsd', 1,
- 'Artistic' => 'artistic', 1,
- 'MIT' => 'mit', 1,
- 'proprietary' => 'proprietary', 0,
- );
- while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) {
- $pattern =~ s{\s+}{\\s+}g;
- if ( $license_text =~ /\b$pattern\b/i ) {
- if ( $osi and $license_text =~ /All rights reserved/i ) {
- warn "LEGAL WARNING: 'All rights reserved' may invalidate Open Source licenses. Consider removing it.";
+ my ( $self, $file ) = @_;
+
+ if (
+ $self->_slurp($file) =~ m/
+ (
+ =head \d \s+
+ (?:licen[cs]e|licensing|copyright|legal)\b
+ .*?
+ )
+ (=head\\d.*|=cut.*|)
+ \z
+ /ixms ) {
+ my $license_text = $1;
+ my @phrases = (
+ 'under the same (?:terms|license) as perl itself' => 'perl', 1,
+ 'GNU public license' => 'gpl', 1,
+ 'GNU lesser public license' => 'lgpl', 1,
+ 'BSD license' => 'bsd', 1,
+ 'Artistic license' => 'artistic', 1,
+ 'GPL' => 'gpl', 1,
+ 'LGPL' => 'lgpl', 1,
+ 'BSD' => 'bsd', 1,
+ 'Artistic' => 'artistic', 1,
+ 'MIT' => 'mit', 1,
+ 'proprietary' => 'proprietary', 0,
+ );
+ while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) {
+ $pattern =~ s{\s+}{\\s+}g;
+ if ( $license_text =~ /\b$pattern\b/i ) {
+ if ( $osi and $license_text =~ /All rights reserved/i ) {
+ warn "LEGAL WARNING: 'All rights reserved' may invalidate Open Source licenses. Consider removing it.";
+ }
+ $self->license($license);
+ return 1;
+ }
}
- $self->license($license);
- return 1;
- }
- }
- }
-
- warn "Cannot determine license info from $file\n";
- return 'unknown';
+ }
+
+ warn "Cannot determine license info from $file\n";
+ return 'unknown';
}
1;
diff --git a/inc/Module/Install/RTx.pm b/inc/Module/Install/RTx.pm
index 3d89b66..20a354b 100644
--- a/inc/Module/Install/RTx.pm
+++ b/inc/Module/Install/RTx.pm
@@ -8,12 +8,15 @@ no warnings 'once';
use Module::Install::Base;
use base 'Module::Install::Base';
-our $VERSION = '0.21';
+our $VERSION = '0.24';
use FindBin;
use File::Glob ();
use File::Basename ();
+my @DIRS = qw(etc lib html bin sbin po var);
+my @INDEX_DIRS = qw(lib bin sbin);
+
sub RTx {
my ( $self, $name ) = @_;
@@ -53,13 +56,15 @@ sub RTx {
}
my $lib_path = File::Basename::dirname( $INC{'RT.pm'} );
+ my $local_lib_path = "$RT::LocalPath/lib";
print "Using RT configuration from $INC{'RT.pm'}:\n";
+ unshift @INC, "$RT::LocalPath/lib" if $RT::LocalPath;
$RT::LocalVarPath ||= $RT::VarPath;
$RT::LocalPoPath ||= $RT::LocalLexiconPath;
$RT::LocalHtmlPath ||= $RT::MasonComponentRoot;
+ $RT::LocalLibPath ||= "$RT::LocalPath/lib";
- my %path;
my $with_subdirs = $ENV{WITH_SUBDIRS};
@ARGV = grep { /WITH_SUBDIRS=(.*)/ ? ( ( $with_subdirs = $1 ), 0 ) : 1 }
@ARGV;
@@ -67,36 +72,40 @@ sub RTx {
my %subdirs;
%subdirs = map { $_ => 1 } split( /\s*,\s*/, $with_subdirs )
if defined $with_subdirs;
-
- foreach (qw(bin etc html po sbin var)) {
- next unless -d "$FindBin::Bin/$_";
- next if %subdirs and !$subdirs{$_};
- $self->no_index( directory => $_ );
-
- no strict 'refs';
- my $varname = "RT::Local" . ucfirst($_) . "Path";
- $path{$_} = ${$varname} || "$RT::LocalPath/$_";
+ unless ( keys %subdirs ) {
+ $subdirs{$_} = 1 foreach grep -d "$FindBin::Bin/$_", @DIRS;
}
- $path{$_} .= "/$name" for grep $path{$_}, qw(etc po var);
- $path{lib} = "$RT::LocalPath/lib" unless %subdirs and !$subdirs{'lib'};
-
# If we're running on RT 3.8 with plugin support, we really wany
# to install libs, mason templates and po files into plugin specific
# directories
- if ($RT::LocalPluginPath) {
- foreach my $path (qw(lib po html etc bin sbin)) {
- next unless -d "$FindBin::Bin/$path";
- next if %subdirs and !$subdirs{$path};
- $path{$path} = $RT::LocalPluginPath . "/$original_name/$path";
+ my %path;
+ if ( $RT::LocalPluginPath ) {
+ die "Because of bugs in RT 3.8.0 this extension can not be installed.\n"
+ ."Upgrade to RT 3.8.1 or newer.\n" if $RT::VERSION =~ /^3\.8\.0/;
+ $path{$_} = $RT::LocalPluginPath . "/$original_name/$_"
+ foreach @DIRS;
+ } else {
+ foreach ( @DIRS ) {
+ no strict 'refs';
+ my $varname = "RT::Local" . ucfirst($_) . "Path";
+ $path{$_} = ${$varname} || "$RT::LocalPath/$_";
}
+
+ $path{$_} .= "/$name" for grep $path{$_}, qw(etc po var);
}
- my $args = join( ', ', map "q($_)", %path );
- print "./$_\t=> $path{$_}\n" for sort keys %path;
+ my %index = map { $_ => 1 } @INDEX_DIRS;
+ $self->no_index( directory => $_ ) foreach grep !$index{$_}, @DIRS;
+
+ my $args = join ', ', map "q($_)", map { ($_, $path{$_}) }
+ grep $subdirs{$_}, keys %path;
- if ( my @dirs = map { ( -D => $_ ) } grep $path{$_}, qw(bin html sbin) ) {
- my @po = map { ( -o => $_ ) } grep -f,
+ print "./$_\t=> $path{$_}\n" for sort keys %subdirs;
+
+ if ( my @dirs = map { ( -D => $_ ) } grep $subdirs{$_}, qw(bin html sbin) ) {
+ my @po = map { ( -o => $_ ) }
+ grep -f,
File::Glob::bsd_glob("po/*.po");
$self->postamble(<< ".") if @po;
lexicons ::
@@ -109,7 +118,7 @@ install ::
\t\$(NOECHO) \$(PERL) -MExtUtils::Install -e \"install({$args})\"
.
- if ( $path{var} and -d $RT::MasonDataDir ) {
+ if ( $subdirs{var} and -d $RT::MasonDataDir ) {
my ( $uid, $gid ) = ( stat($RT::MasonDataDir) )[ 4, 5 ];
$postamble .= << ".";
\t\$(NOECHO) chown -R $uid:$gid $path{var}
@@ -124,10 +133,10 @@ install ::
$self->load('RTxFactory');
$self->postamble(<< ".");
factory ::
-\t\$(NOECHO) \$(PERL) -Ilib -I"$lib_path" -Minc::Module::Install -e"RTxFactory(qw($RTx $name))"
+\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxFactory(qw($RTx $name))"
dropdb ::
-\t\$(NOECHO) \$(PERL) -Ilib -I"$lib_path" -Minc::Module::Install -e"RTxFactory(qw($RTx $name drop))"
+\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxFactory(qw($RTx $name drop))"
.
}
@@ -137,28 +146,29 @@ dropdb ::
if ( -e 'etc/initialdata' ) { $has_etc{initialdata}++; }
$self->postamble("$postamble\n");
- if ( %subdirs and !$subdirs{'lib'} ) {
+ unless ( $subdirs{'lib'} ) {
$self->makemaker_args( PM => { "" => "" }, );
} else {
- $self->makemaker_args( INSTALLSITELIB => "$RT::LocalPath/lib" );
+ $self->makemaker_args( INSTALLSITELIB => $path{'lib'} );
+ $self->makemaker_args( INSTALLARCHLIB => $path{'lib'} );
}
- $self->makemaker_args( INSTALLSITEMAN1DIR => "$RT::LocalPath/man/man1" );
- $self->makemaker_args( INSTALLSITEMAN3DIR => "$RT::LocalPath/man/man3" );
- $self->makemaker_args( INSTALLSITEARCH => "$RT::LocalPath/man" );
- $self->makemaker_args( INSTALLARCHLIB => "$RT::LocalPath/lib" );
+ $self->makemaker_args( INSTALLSITEMAN1DIR => "$RT::LocalPath/man/man1" );
+ $self->makemaker_args( INSTALLSITEMAN3DIR => "$RT::LocalPath/man/man3" );
+ $self->makemaker_args( INSTALLSITEARCH => "$RT::LocalPath/man" );
+
if (%has_etc) {
$self->load('RTxInitDB');
print "For first-time installation, type 'make initdb'.\n";
my $initdb = '';
$initdb .= <<"." if $has_etc{schema};
-\t\$(NOECHO) \$(PERL) -Ilib -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(schema))"
+\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(schema))"
.
$initdb .= <<"." if $has_etc{acl};
-\t\$(NOECHO) \$(PERL) -Ilib -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(acl))"
+\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(acl))"
.
$initdb .= <<"." if $has_etc{initialdata};
-\t\$(NOECHO) \$(PERL) -Ilib -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(insert))"
+\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(insert))"
.
$self->postamble("initdb ::\n$initdb\n");
$self->postamble("initialize-database ::\n$initdb\n");
@@ -178,4 +188,4 @@ sub RTxInit {
__END__
-#line 279
+#line 302
diff --git a/inc/Module/Install/Win32.pm b/inc/Module/Install/Win32.pm
index 4f808c7..21a81ab 100644
--- a/inc/Module/Install/Win32.pm
+++ b/inc/Module/Install/Win32.pm
@@ -4,11 +4,11 @@ package Module::Install::Win32;
use strict;
use Module::Install::Base;
-use vars qw{$VERSION $ISCORE @ISA};
+use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.68';
- $ISCORE = 1;
+ $VERSION = '0.70';
@ISA = qw{Module::Install::Base};
+ $ISCORE = 1;
}
# determine if the user needs nmake, and download it if needed
@@ -16,7 +16,7 @@ sub check_nmake {
my $self = shift;
$self->load('can_run');
$self->load('get_file');
-
+
require Config;
return unless (
$^O eq 'MSWin32' and
@@ -38,8 +38,7 @@ sub check_nmake {
remove => 1,
);
- if (!$rv) {
- die <<'END_MESSAGE';
+ die <<'END_MESSAGE' unless $rv;
-------------------------------------------------------------------------------
@@ -59,7 +58,7 @@ You may then resume the installation process described in README.
-------------------------------------------------------------------------------
END_MESSAGE
- }
+
}
1;
diff --git a/inc/Module/Install/WriteAll.pm b/inc/Module/Install/WriteAll.pm
index 078797c..a05592d 100644
--- a/inc/Module/Install/WriteAll.pm
+++ b/inc/Module/Install/WriteAll.pm
@@ -4,40 +4,37 @@ package Module::Install::WriteAll;
use strict;
use Module::Install::Base;
-use vars qw{$VERSION $ISCORE @ISA};
+use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.68';
- $ISCORE = 1;
+ $VERSION = '0.70';
@ISA = qw{Module::Install::Base};
+ $ISCORE = 1;
}
sub WriteAll {
- my $self = shift;
- my %args = (
- meta => 1,
- sign => 0,
- inline => 0,
- check_nmake => 1,
- @_
- );
+ my $self = shift;
+ my %args = (
+ meta => 1,
+ sign => 0,
+ inline => 0,
+ check_nmake => 1,
+ @_,
+ );
+
+ $self->sign(1) if $args{sign};
+ $self->Meta->write if $args{meta};
+ $self->admin->WriteAll(%args) if $self->is_admin;
- $self->sign(1) if $args{sign};
- $self->Meta->write if $args{meta};
- $self->admin->WriteAll(%args) if $self->is_admin;
+ $self->check_nmake if $args{check_nmake};
+ unless ( $self->makemaker_args->{PL_FILES} ) {
+ $self->makemaker_args( PL_FILES => {} );
+ }
- if ( $0 =~ /Build.PL$/i ) {
- $self->Build->write;
- } else {
- $self->check_nmake if $args{check_nmake};
- unless ( $self->makemaker_args->{'PL_FILES'} ) {
- $self->makemaker_args( PL_FILES => {} );
- }
- if ($args{inline}) {
- $self->Inline->write;
- } else {
- $self->Makefile->write;
- }
- }
+ if ( $args{inline} ) {
+ $self->Inline->write;
+ } else {
+ $self->Makefile->write;
+ }
}
1;
commit 08e872be34e00e9cafee8cc3dc25c75612880c6e
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Fri Oct 17 16:38:04 2008 +0000
* patch for 3.8
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth@16316 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/lib/RT/User_Vendor.pm b/lib/RT/User_Vendor.pm
index 7d8591b..db5fdaa 100644
--- a/lib/RT/User_Vendor.pm
+++ b/lib/RT/User_Vendor.pm
@@ -348,7 +348,7 @@ sub IsPassword {
return (undef);
}
- if ( $self->PrincipalObj->Disabled ) {
+ if ( $self->PrincipalObj && $self->PrincipalObj->Disabled ) {
$RT::Logger->info("Disabled user " . $self->Name .
" tried to log in" );
return (undef);
commit e4e232035e3c7387cf24da59e8a6259c27b45bf4
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Fri Oct 17 16:38:17 2008 +0000
* add required modules
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth@16317 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/Makefile.PL b/Makefile.PL
index 91f0596..382d40f 100755
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -8,5 +8,11 @@ author('Mike Peachey <zordrak at cpan.org>');
all_from('lib/RT/Authen/ExternalAuth.pm');
requires('RT');
+requires('Net::LDAP');
+features(
+ 'SSL LDAP Connections' => [
+ -default => 0,
+ 'Net::SSLeay' => 0]
+);
&WriteAll;
commit ef715989f98f91b8941b5829ce2c87409d9d564f
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Fri Oct 17 16:38:48 2008 +0000
* update docs
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth@16318 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/ChangeLog b/ChangeLog
index 496c57b..00e78e7 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,16 @@
+v0.06_02 2008-10-17 Kevin Falcone <falcone at cpan.org>
+
+ * update changelog
+
+v0.06_01 2008-10-17 Kevin Falcone <falcone at cpan.org>
+
+ * lib/RT/Authen/User_Vendor.pm
+
+ Add a patch to be compatible with 3.8
+
+ * Upgrade Module::Install::RTx to work better
+ with 3.8
+
v0.05 2008-04-09 Mike Peachey <zordrak at cpan.org>
* lib/RT/Authen/User_Vendor.pm
diff --git a/README b/README
index be2d917..00a27f6 100644
--- a/README
+++ b/README
@@ -28,9 +28,16 @@ To install this module, run the following commands:
make
make install
+If you are using RT 3.8.x, you need to enable this
+module by adding RT::Authen::ExternalAuth to your
+ at Plugins configuration:
+
+Set( @Plugins, qw(RT::Authen::ExternalAuth) );
+
Once installed, you should view the file:
- $RTHOME/local/etc/ExternalAuth/RT_SiteConfig.pm
+3.4/3.6 $RTHOME/local/etc/ExternalAuth/RT_SiteConfig.pm
+3.8 $RTHOME/local/plugins/RT-Auth-ExternalAuth/etc/RT_SiteConfig.pm
Then use the examples provided to prepare your own custom
configuration which should reside in
commit bf3a6118654979261306329d72e973cdaaff42cd
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Fri Oct 17 16:38:57 2008 +0000
* bump version number
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth@16319 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/META.yml b/META.yml
index 0bb511e..4028112 100644
--- a/META.yml
+++ b/META.yml
@@ -1,20 +1,21 @@
----
+---
abstract: RT Authen-ExternalAuth Extension
-author:
- - 'Mike Peachey <zordrak at cpan.org>'
+author:
+ - Mike Peachey <zordrak at cpan.org>
distribution_type: module
-generated_by: Module::Install version 0.68
+generated_by: Module::Install version 0.70
license: GPL version 2
-meta-spec:
+meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.3.html
version: 1.3
name: RT-Authen-ExternalAuth
-no_index:
- directory:
+no_index:
+ directory:
- etc
- html
+ - po
+ - var
- inc
- - t
-requires:
+requires:
RT: 0
-version: 0.05
+version: 0.06_02
diff --git a/lib/RT/Authen/ExternalAuth.pm b/lib/RT/Authen/ExternalAuth.pm
index 2d8c6c1..2303157 100644
--- a/lib/RT/Authen/ExternalAuth.pm
+++ b/lib/RT/Authen/ExternalAuth.pm
@@ -1,6 +1,6 @@
package RT::Authen::ExternalAuth;
-our $VERSION = '0.05';
+our $VERSION = '0.06_02';
=head1 NAME
commit c1b6e10853b8d0f4a9c045882c725e9bcc69aade
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Fri Oct 17 16:40:20 2008 +0000
* add Net::LDAP requirement
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth@16320 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/META.yml b/META.yml
index 4028112..dd317fc 100644
--- a/META.yml
+++ b/META.yml
@@ -17,5 +17,6 @@ no_index:
- var
- inc
requires:
+ Net::LDAP: 0
RT: 0
version: 0.06_02
commit 16648e4f9370690eb882ac739558328e58012c12
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Thu Oct 23 01:21:25 2008 +0000
* add note about bogus files in /local that need to be deleted
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@16506 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/README b/README
index 00a27f6..8ee820d 100644
--- a/README
+++ b/README
@@ -47,6 +47,16 @@ Alternatively, you may alter the provided examples directly
and then include the extra directives by including the
example file's path at the end of your RT_SiteConfig.pm
+UPGRADING
+
+If you are upgrading from 0.05 you may have some leftover
+parts of the module in
+
+$RTHOME/local/lib/RT/User_Vendor.pm
+$RTHOME/local/lib/RT/Authen/External_Auth.pm
+
+that will conflict with the new install and should be removed
+
AUTHOR
Mike Peachey
Jennic Ltd.
commit fc6546237c316e977d83388eefdafb87c4f802dc
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Tue Oct 28 19:03:16 2008 +0000
* handle errors on Create
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@16579 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/html/Callbacks/ExternalAuth/autohandler/Auth b/html/Callbacks/ExternalAuth/autohandler/Auth
index cd0910a..1ef2c03 100644
--- a/html/Callbacks/ExternalAuth/autohandler/Auth
+++ b/html/Callbacks/ExternalAuth/autohandler/Auth
@@ -47,6 +47,10 @@ unless ($session{'CurrentUser'}) {
Name => $user,
Gecos => $user,
);
+ unless ($val) {
+ $RT::Logger->error( "Couldn't create user $user: $msg" );
+ return;
+ }
$RT::Logger->info( "Autocreated authenticated user",
$UserObj->Name,
"(",
commit 0b2b5abc919c15fa4183e5c334381770abe1b0f4
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Tue Oct 28 19:03:26 2008 +0000
* whine in the logs when a user doesn't specify d_filter
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@16580 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/lib/RT/User_Vendor.pm b/lib/RT/User_Vendor.pm
index db5fdaa..229e736 100644
--- a/lib/RT/User_Vendor.pm
+++ b/lib/RT/User_Vendor.pm
@@ -819,6 +819,9 @@ sub UpdateFromExternal {
if ($filter eq "()") { undef($filter) };
if ($disable_filter eq "()") { undef($disable_filter) };
+ unless ($disable_filter) {
+ $RT::Logger->error("You haven't specified a d_filter in your configuration. Not specifying a d_filter usually results in all users being marked as disabled and being unable to log in");
+ }
if (defined($config->{'attr_map'}->{'Name'})) {
# Construct the complex filter
commit f04ec4a34880013424ef411ae768020391e3b4af
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Tue Oct 28 19:03:29 2008 +0000
* add more error handling
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@16581 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/html/Callbacks/ExternalAuth/autohandler/Auth b/html/Callbacks/ExternalAuth/autohandler/Auth
index 1ef2c03..a246a47 100644
--- a/html/Callbacks/ExternalAuth/autohandler/Auth
+++ b/html/Callbacks/ExternalAuth/autohandler/Auth
@@ -61,7 +61,12 @@ unless ($session{'CurrentUser'}) {
# If we autocreated a user, then load the user as the CurrentUser in $session
# To RT, this means we have a valid, authenticated user
- $session{'CurrentUser'}->Load($user) if $UserObj->Id;
+ if ($UserObj->Id) {
+ my ($ret, $msg) = $session{'CurrentUser'}->Load($user);
+ unless ($ret) {
+ $RT::Logger->error("Couldn't load user $user: $msg");
+ }
+ }
}
}
commit 82b62de2f554e37582fcd048c7969085691020b3
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Wed Oct 29 16:21:59 2008 +0000
* changes since 06_02
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@16599 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/ChangeLog b/ChangeLog
index 00e78e7..4a6267a 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+ * update README to talk about removing old files in local/
+ * complain if a user doesn't specify a d_filter
+ * Check the return value from calling RT::User::Create
+ * Check the return value when loading an autocreated user
+
v0.06_02 2008-10-17 Kevin Falcone <falcone at cpan.org>
* update changelog
commit 7ec8cca84fc1bc63832b9717e7beacacff823e85
Author: Mike Peachey <zordrak at cpan.org>
Date: Fri Oct 31 11:46:19 2008 +0000
RT::Authen::ExternalAuth v0.06_03
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@16636 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/ChangeLog b/ChangeLog
index 4a6267a..574c4e6 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,20 +1,53 @@
- * update README to talk about removing old files in local/
- * complain if a user doesn't specify a d_filter
- * Check the return value from calling RT::User::Create
- * Check the return value when loading an autocreated user
+v0.06_03 2008-10-31 Mike Peachey <zordrak at cpan.org>
+ Kevin Falcone <falcone at cpan.org>
-v0.06_02 2008-10-17 Kevin Falcone <falcone at cpan.org>
+ * html/Callbacks/ExternalAuth/autohandler/Auth
+
+ Add fix to work around a plugin bug in RT-3.8.0 & RT-3.8.1
+ preventing User_Vendor.pm overlay being required before
+ RT::User is loaded.
+
+ Check the return value from calling RT::User::Create.
+
+ Check the return value when loading an autocreated user.
+
+ * README
+
+ Updated to talk about removing old files in local/.
+
+ * lib/RT/Authen/User_Vendor.pm
+
+ Added error-checking to complain if a an LDAP configuration is
+ in use, but no d_filter has been specified.
- * update changelog
+ * lib/RT/Authen/ExternalAuth.pm
+
+ Version updated to 0.06_03.
-v0.06_01 2008-10-17 Kevin Falcone <falcone at cpan.org>
+ * ChangeLog
- * lib/RT/Authen/User_Vendor.pm
+ General clean-up.
- Add a patch to be compatible with 3.8
- * Upgrade Module::Install::RTx to work better
- with 3.8
+v0.06_02 2008-10-01 Kevin Falcone <falcone at cpan.org>
+
+ * ChangeLog
+
+ Updates to previous release.
+
+ * lib/RT/Authen/ExternalAuth.pm
+
+ Version updated to 0.06_02.
+
+
+v0.06_01 2008-10-17 Kevin Falcone <falcone at cpan.org>
+
+ * lib/RT/Authen/User_Vendor.pm
+
+ Add a patch to be compatible with 3.8
+
+ * Upgrade Module::Install::RTx to work better with RT-3.8.x
+
v0.05 2008-04-09 Mike Peachey <zordrak at cpan.org>
@@ -47,6 +80,7 @@ v0.05 2008-04-09 Mike Peachey <zordrak at cpan.org>
Version updated to 0.05
+
v0.04 2008-04-03 Mike Peachey <zordrak at cpan.org>
* etc/RT_SiteConfig.pm
@@ -65,6 +99,7 @@ v0.04 2008-04-03 Mike Peachey <zordrak at cpan.org>
Version updated to 0.04
+
v0.03 2008-03-31 Mike Peachey <zordrak at cpan.org>
* html/Callbacks/ExternalAuth/autohandler/Auth
@@ -99,6 +134,7 @@ v0.03 2008-03-31 Mike Peachey <zordrak at cpan.org>
Version updated to 0.03
+
v0.02 2008-03-17 Mike Peachey <zordrak at cpan.org>
* lib/RT/User_Vendor.pm
@@ -121,6 +157,7 @@ v0.02 2008-03-17 Mike Peachey <zordrak at cpan.org>
Version updated to 0.02
+
v0.01 2008-03-13 Mike Peachey <zordrak at cpan.org>
* Initial Release
diff --git a/html/Callbacks/ExternalAuth/autohandler/Auth b/html/Callbacks/ExternalAuth/autohandler/Auth
index a246a47..592de29 100644
--- a/html/Callbacks/ExternalAuth/autohandler/Auth
+++ b/html/Callbacks/ExternalAuth/autohandler/Auth
@@ -1,5 +1,15 @@
<%init>
+# If the RT::User::UpdateFromExternal method is not available, then we are in
+# RT-3.8.0 or RT-3.8.1 and we need to work around a bug in the plugin system:
+# Temporarily force RT to reload RT::User, since it isn't being loaded
+# correctly as a plugin.
+unless (RT::User->can('UpdateFromExternal')) {
+ $RT::Logger->error("Working around bug in RT and reloading RT::User");
+ delete $INC{'RT/User.pm'};
+ require RT::User;
+}
+
# If the user is logging in, let's authenticate; if they can auth but don't load
# (e.g. they don't have an account but external auth succeeds), we'll autocreate
# their account.
diff --git a/lib/RT/Authen/ExternalAuth.pm b/lib/RT/Authen/ExternalAuth.pm
index 2303157..f896849 100644
--- a/lib/RT/Authen/ExternalAuth.pm
+++ b/lib/RT/Authen/ExternalAuth.pm
@@ -1,6 +1,6 @@
package RT::Authen::ExternalAuth;
-our $VERSION = '0.06_02';
+our $VERSION = '0.06_03';
=head1 NAME
commit 1fd093feab589e63336aba51aa191a05fc422364
Author: Mike Peachey <zordrak at cpan.org>
Date: Sat Nov 1 18:19:33 2008 +0000
RT::Authen::ExternalAuth v0.06 - First 3.8.x Compatible Release
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@16649 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/ChangeLog b/ChangeLog
index 574c4e6..2b9d362 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,18 @@
+v0.06 2008-11-01 Mike Peachey <zordrak at cpan.org>
+
+ * README
+
+ A few minor tweaks.
+
+ * lib/RT/Authen/ExternalAuth.pm
+
+ Version updated to 0.06
+
+ * etc/RT_SiteConfig.pm
+
+ A number of clarifications added to the example config comments
+ such as making clear the fact that a valid d_filter is required.
+
v0.06_03 2008-10-31 Mike Peachey <zordrak at cpan.org>
Kevin Falcone <falcone at cpan.org>
diff --git a/README b/README
index 8ee820d..28c8d1d 100644
--- a/README
+++ b/README
@@ -20,6 +20,7 @@ But it has been designed so that it should work with ANY
LDAP service and ANY DBI-drivable database, based upon the
configuration given in your $RTHOME/etc/RT_SiteConfig.pm
+
INSTALLATION
To install this module, run the following commands:
@@ -40,13 +41,14 @@ Once installed, you should view the file:
3.8 $RTHOME/local/plugins/RT-Auth-ExternalAuth/etc/RT_SiteConfig.pm
Then use the examples provided to prepare your own custom
-configuration which should reside in
+configuration which should be added to your site configuration in
$RTHOME/etc/RT_SiteConfig.pm
Alternatively, you may alter the provided examples directly
-and then include the extra directives by including the
+and then include the extra directives by 'requiring' the
example file's path at the end of your RT_SiteConfig.pm
+
UPGRADING
If you are upgrading from 0.05 you may have some leftover
@@ -55,7 +57,7 @@ parts of the module in
$RTHOME/local/lib/RT/User_Vendor.pm
$RTHOME/local/lib/RT/Authen/External_Auth.pm
-that will conflict with the new install and should be removed
+that will conflict with the new install and these should be removed
AUTHOR
Mike Peachey
diff --git a/etc/RT_SiteConfig.pm b/etc/RT_SiteConfig.pm
index ec0c00c..cc88b16 100644
--- a/etc/RT_SiteConfig.pm
+++ b/etc/RT_SiteConfig.pm
@@ -108,10 +108,18 @@ Set($ExternalSettings, { # AN EXAMPLE DB SERVICE
#
# The LDAP search base
'base' => 'ou=Organisational Unit,dc=domain,dc=TLD',
+ #
+ # ALL FILTERS MUST BE VALID LDAP FILTERS ENCASED IN PARENTHESES!
+ # YOU **MUST** SPECIFY A filter AND A d_filter!!
+ #
# The filter to use to match RT-Users
'filter' => '(FILTER_STRING)',
+ # A catch-all example filter: '(objectClass=*)'
+ #
# The filter that will only match disabled users
'd_filter' => '(FILTER_STRING)',
+ # A catch-none example d_filter: '(objectClass=FooBarBaz)'
+ #
# Should we try to use TLS to encrypt connections?
'tls' => 0,
# What other args should I pass to Net::LDAP->new($host, at args)?
@@ -122,6 +130,8 @@ Set($ExternalSettings, { # AN EXAMPLE DB SERVICE
'group_attr' => 'GROUP_ATTR',
## RT ATTRIBUTE MATCHING SECTION
# The list of RT attributes that uniquely identify a user
+ # This example shows what you *can* specify.. I recommend reducing this
+ # to just the Name and EmailAddress to save encountering problems later.
'attr_match_list' => [ 'Name',
'EmailAddress',
'RealName',
diff --git a/lib/RT/Authen/ExternalAuth.pm b/lib/RT/Authen/ExternalAuth.pm
index f896849..5406056 100644
--- a/lib/RT/Authen/ExternalAuth.pm
+++ b/lib/RT/Authen/ExternalAuth.pm
@@ -1,6 +1,6 @@
package RT::Authen::ExternalAuth;
-our $VERSION = '0.06_03';
+our $VERSION = '0.06';
=head1 NAME
commit c2be05ef93bbf76ffa68b67817a328271e8141fc
Author: Mike Peachey <zordrak at cpan.org>
Date: Tue Nov 4 13:01:26 2008 +0000
Update to Auth callback :: Change method for looking up ::AutoCreate
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@16656 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/html/Callbacks/ExternalAuth/autohandler/Auth b/html/Callbacks/ExternalAuth/autohandler/Auth
index 592de29..5a6abb8 100644
--- a/html/Callbacks/ExternalAuth/autohandler/Auth
+++ b/html/Callbacks/ExternalAuth/autohandler/Auth
@@ -52,11 +52,11 @@ unless ($session{'CurrentUser'}) {
if ($password_validated) {
### If there were a standard param to check for whether or not we
### should autocreate authenticated users, we'd check it here.
- my ($val, $msg) =
- $UserObj->Create(%{ref($RT::AutoCreate) ? $RT::AutoCreate : {}},
- Name => $user,
- Gecos => $user,
- );
+ my ($val, $msg) = $UserObj->Create(
+ %{ ref RT->Config->Get('AutoCreate') ? RT->Config->Get('AutoCreate') : {} },
+ Name => $user,
+ Gecos => $user,
+ );
unless ($val) {
$RT::Logger->error( "Couldn't create user $user: $msg" );
return;
commit 0b8f3273cdc5dfec08b7bfedc3fc573afd25167a
Author: Mike Peachey <zordrak at cpan.org>
Date: Tue Nov 4 13:24:28 2008 +0000
Reverting RT::Authen::ExternalAuth Auth callback to 16655 - 3.6 compat broken
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@16658 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/html/Callbacks/ExternalAuth/autohandler/Auth b/html/Callbacks/ExternalAuth/autohandler/Auth
index 5a6abb8..592de29 100644
--- a/html/Callbacks/ExternalAuth/autohandler/Auth
+++ b/html/Callbacks/ExternalAuth/autohandler/Auth
@@ -52,11 +52,11 @@ unless ($session{'CurrentUser'}) {
if ($password_validated) {
### If there were a standard param to check for whether or not we
### should autocreate authenticated users, we'd check it here.
- my ($val, $msg) = $UserObj->Create(
- %{ ref RT->Config->Get('AutoCreate') ? RT->Config->Get('AutoCreate') : {} },
- Name => $user,
- Gecos => $user,
- );
+ my ($val, $msg) =
+ $UserObj->Create(%{ref($RT::AutoCreate) ? $RT::AutoCreate : {}},
+ Name => $user,
+ Gecos => $user,
+ );
unless ($val) {
$RT::Logger->error( "Couldn't create user $user: $msg" );
return;
commit 2bcbb9064603157c5fb6bcd30d7f8141711e9837
Author: Mike Peachey <zordrak at cpan.org>
Date: Tue Nov 4 17:38:30 2008 +0000
* Initial attempt at refactoring RT-Authen/ExternalAuth
* UpdateFromExternal yet to be refactored
* All lower code should be done, but is unchecked
* Needed to check what I've done in before going home for my own sanity
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@16661 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/lib/RT/Authen/ExternalAuth/DBI.pm b/lib/RT/Authen/ExternalAuth/DBI.pm
new file mode 100644
index 0000000..f3555aa
--- /dev/null
+++ b/lib/RT/Authen/ExternalAuth/DBI.pm
@@ -0,0 +1,219 @@
+package RT::Authen::ExternalAuth::DBI;
+use DBI;
+
+sub getAuth {
+
+ my ($service, $username, $password) = @_;
+
+ my $config = $RT::ExternalSettings->{$service};
+ $RT::Logger->debug( "Trying external auth service:",$service);
+
+ my $db_table = $config->{'table'};
+ my $db_u_field = $config->{'u_field'};
+ my $db_p_field = $config->{'p_field'};
+ my $db_p_enc_pkg = $config->{'p_enc_pkg'};
+ my $db_p_enc_sub = $config->{'p_enc_sub'};
+
+ # Set SQL query and bind parameters
+ my $query = "SELECT $db_u_field,$db_p_field FROM $db_table WHERE $db_u_field=?";
+ my @params = ($username);
+
+ # Uncomment this to trace basic DBI information and drop it in a log for debugging
+ # DBI->trace(1,'/tmp/dbi.log');
+
+ # Get DBI handle object (DBH), do SQL query, kill DBH
+ my $dbh = _GetBoundDBIObj($config);
+ return 0 unless $dbh;
+
+ my $results_hashref = $dbh->selectall_hashref($query,$db_u_field,{}, at params);
+ $dbh->disconnect();
+
+ my $num_users_returned = scalar keys %$results_hashref;
+ if($num_users_returned != 1) { # FAIL
+ # FAIL because more than one user returned. Users MUST be unique!
+ if ((scalar keys %$results_hashref) > 1) {
+ $RT::Logger->info( $service,
+ "AUTH FAILED",
+ $username,
+ "More than one user with that username!");
+ }
+
+ # FAIL because no users returned. Users MUST exist!
+ if ((scalar keys %$results_hashref) < 1) {
+ $RT::Logger->info( $service,
+ "AUTH FAILED",
+ $username,
+ "User not found in database!");
+ }
+
+ # Drop out to next external authentication service
+ return 0;
+ }
+
+ # Get the user's password from the database query result
+ my $pass_from_db = $results_hashref->{$username}->{$db_p_field};
+
+ # This is the encryption package & subroutine passed in by the config file
+ $RT::Logger->debug( "Encryption Package:",
+ $db_p_enc_pkg);
+ $RT::Logger->debug( "Encryption Subroutine:",
+ $db_p_enc_sub);
+
+ # Use config info to auto-load the perl package needed for password encryption
+ # I know it uses a string eval - but I don't think there's a better way to do this
+ # Jump to next external authentication service on failure
+ eval "require $db_p_enc_pkg" or
+ $RT::Logger->error("AUTH FAILED, Couldn't Load Password Encryption Package. Error: $@") && return 0;
+
+ my $encrypt = $db_p_enc_pkg->can($db_p_enc_sub);
+ if (defined($encrypt)) {
+ # If the package given can perform the subroutine given, then use it to compare the
+ # password given with the password pulled from the database.
+ # Jump to the next external authentication service if they don't match
+ if(${encrypt}->($password) ne $pass_from_db){
+ $RT::Logger->info( $service,
+ "AUTH FAILED",
+ $username,
+ "Password Incorrect");
+ return 0;
+ }
+ } else {
+ # If the encryption package can't perform the request subroutine,
+ # dump an error and jump to the next external authentication service.
+ $RT::Logger->error($service,
+ "AUTH FAILED",
+ "The encryption package you gave me (",
+ $db_p_enc_pkg,
+ ") does not support the encryption method you specified (",
+ $db_p_enc_sub,
+ ")");
+ return 0;
+ }
+
+ # Any other checks you want to add? Add them here.
+
+ # If we've survived to this point, we're good.
+ $RT::Logger->info( (caller(0))[3],
+ "External Auth OK (",
+ $service,
+ "):",
+ $username);
+
+ return 1;
+}
+
+sub FindUserThenReturnInfo {
+
+ my ($service, $key, $value) = @_;
+
+ my $found = 0;
+ my %params = (Name => undef,
+ EmailAddress => undef,
+ RealName => undef);
+
+ # Load the config
+ my $config = $RT::ExternalSettings->{$service};
+
+ # Figure out what's what
+ my $table = $config->{'table'};
+
+ unless ($table) {
+ $RT::Logger->critical( (caller(0))[3],
+ "No table given");
+ # Drop out to the next external information service
+ return ($found, %params);
+ }
+
+ unless ($key && $value){
+ $RT::Logger->critical( (caller(0))[3],
+ " Nothing to look-up given");
+ # Drop out to the next external information service
+ return ($found, %params);
+ }
+
+ # "where" refers to WHERE section of SQL query
+ my ($where_key,$where_value) = ("@{[ $key ]}",$value);
+
+ # Get the list of unique attrs we need
+ my %db_attrs = map {$_ => 1} values(%{$config->{'attr_map'}});
+ my @attrs = keys(%db_attrs);
+ my $fields = join(',', at attrs);
+ my $query = "SELECT $fields FROM $table WHERE $where_key=?";
+ my @bind_params = ($where_value);
+
+ # Uncomment this to trace basic DBI throughput in a log
+ # DBI->trace(1,'/tmp/dbi.log');
+ my $dbh = $self->_GetBoundDBIObj($config);
+ my $results_hashref = $dbh->selectall_hashref($query,$key,{}, at bind_params);
+ $dbh->disconnect();
+
+ if ((scalar keys %$results_hashref) != 1) {
+ # If returned users <> 1, we have no single unique user, so prepare to die
+ my $death_msg;
+
+ if ((scalar keys %$results_hashref) == 0) {
+ # If no user...
+ $death_msg = "No User Found in External Database!";
+ } else {
+ # If more than one user...
+ $death_msg = "More than one user found in External Database with that unique identifier!";
+ }
+
+ # Log the death
+ $RT::Logger->info( (caller(0))[3],
+ "INFO CHECK FAILED",
+ "Key: $key",
+ "Value: $value",
+ $death_msg);
+
+ # $found remains as 0
+
+ # Drop out to next external information service
+ return ($found, %params);
+ }
+
+ # We haven't dropped out, so DB search must have succeeded with
+ # exactly 1 result. Get the result and set $found to 1
+ my $result = $results_hashref->{$value};
+
+ # Use the result to populate %params for every key we're given in the config
+ foreach my $key (keys(%{$config->{'attr_map'}})) {
+ $params{$key} = ($result->{$config->{'attr_map'}->{$key}})[0];
+ }
+
+ $found = 1;
+
+ return ($found, %params);
+}
+
+# {{{ sub _GetBoundDBIObj
+
+sub _GetBoundDBIObj {
+
+ # Config as hashref.
+ my $config = shift;
+
+ # Extract the relevant information from the config.
+ my $db_server = $config->{'server'};
+ my $db_user = $config->{'user'};
+ my $db_pass = $config->{'pass'};
+ my $db_database = $config->{'database'};
+ my $db_port = $config->{'port'};
+ my $dbi_driver = $config->{'dbi_driver'};
+
+ # Use config to create a DSN line for the DBI connection
+ my $dsn = "dbi:$dbi_driver:database=$db_database;host=$db_server;port=$db_port";
+
+ # Now let's get connected
+ my $dbh = DBI->connect($dsn, $db_user, $db_pass,{RaiseError => 1, AutoCommit => 0 })
+ or die $DBI::errstr;
+
+ # If we didn't die, return the DBI object handle
+ # and hope it's treated sensibly and correctly
+ # destroyed by the calling code
+ return $dbh;
+}
+
+# }}}
+
+1;
\ No newline at end of file
diff --git a/lib/RT/Authen/ExternalAuth/LDAP.pm b/lib/RT/Authen/ExternalAuth/LDAP.pm
new file mode 100644
index 0000000..c2b92ef
--- /dev/null
+++ b/lib/RT/Authen/ExternalAuth/LDAP.pm
@@ -0,0 +1,327 @@
+package RT::Authen::ExternalAuth::LDAP;
+use Net::LDAP qw(LDAP_SUCCESS LDAP_PARTIAL_RESULTS);
+use Net::LDAP::Util qw(ldap_error_name);
+use Net::LDAP::Filter;
+
+sub getAuth {
+
+ my ($service, $username, $password) = @_;
+
+ my $config = $RT::ExternalSettings->{$service};
+ $RT::Logger->debug( "Trying external auth service:",$service);
+
+ my $base = $config->{'base'};
+ my $filter = $config->{'filter'};
+ my $group = $config->{'group'};
+ my $group_attr = $config->{'group_attr'};
+ my $attr_map = $config->{'attr_map'};
+ my @attrs = ('dn');
+
+ # Empty parentheses as filters cause Net::LDAP to barf.
+ # We take care of this by using Net::LDAP::Filter, but
+ # there's no harm in fixing this right now.
+ if ($filter eq "()") { undef($filter) };
+
+ # Now let's get connected
+ my $ldap = _GetBoundLdapObj($config);
+ return 0 unless ($ldap);
+
+ $filter = Net::LDAP::Filter->new( '(&(' .
+ $attr_map->{'Name'} .
+ '=' .
+ $self->Name .
+ ')' .
+ $filter .
+ ')'
+ );
+
+ $RT::Logger->debug( "LDAP Search === ",
+ "Base:",
+ $base,
+ "== Filter:",
+ $filter->as_string,
+ "== Attrs:",
+ join(',', at attrs));
+
+ my $ldap_msg = $ldap->search( base => $base,
+ filter => $filter,
+ attrs => \@attrs);
+
+ unless ($ldap_msg->code == LDAP_SUCCESS || $ldap_msg->code == LDAP_PARTIAL_RESULTS) {
+ $RT::Logger->debug( "search for",
+ $filter->as_string,
+ "failed:",
+ ldap_error_name($ldap_msg->code),
+ $ldap_msg->code);
+ # Didn't even get a partial result - jump straight to the next external auth service
+ retun 0;
+ }
+
+ unless ($ldap_msg->count == 1) {
+ $RT::Logger->info( $service,
+ "AUTH FAILED:",
+ $self->Name,
+ "User not found or more than one user found");
+ # We got no user, or too many users.. jump straight to the next external auth service
+ return 0;
+ }
+
+ my $ldap_dn = $ldap_msg->first_entry->dn;
+ $RT::Logger->debug( "Found LDAP DN:",
+ $ldap_dn);
+
+ # THIS bind determines success or failure on the password.
+ $ldap_msg = $ldap->bind($ldap_dn, password => $pass_to_auth);
+
+ unless ($ldap_msg->code == LDAP_SUCCESS) {
+ $RT::Logger->info( $service,
+ "AUTH FAILED",
+ $self->Name,
+ "(can't bind:",
+ ldap_error_name($ldap_msg->code),
+ $ldap_msg->code,
+ ")");
+ # Could not bind to the LDAP server as the user we found with the password
+ # we were given, therefore the password must be wrong so we fail and
+ # jump straight to the next external auth service
+ return 0;
+ }
+
+ # The user is authenticated ok, but is there an LDAP Group to check?
+ if ($group) {
+ # If we've been asked to check a group...
+ $filter = Net::LDAP::Filter->new("(${group_attr}=${ldap_dn})");
+
+ $RT::Logger->debug( "LDAP Search === ",
+ "Base:",
+ $base,
+ "== Filter:",
+ $filter->as_string,
+ "== Attrs:",
+ join(',', at attrs));
+
+ $ldap_msg = $ldap->search( base => $group,
+ filter => $filter,
+ attrs => \@attrs,
+ scope => 'base');
+
+ # And the user isn't a member:
+ unless ($ldap_msg->code == LDAP_SUCCESS ||
+ $ldap_msg->code == LDAP_PARTIAL_RESULTS) {
+ $RT::Logger->critical( "Search for",
+ $filter->as_string,
+ "failed:",
+ ldap_error_name($ldap_msg->code),
+ $ldap_msg->code);
+
+ # Fail auth - jump to next external auth service
+ return 0;
+ }
+
+ unless ($ldap_msg->count == 1) {
+ $RT::Logger->info( $service,
+ "AUTH FAILED:",
+ $self->Name);
+
+ # Fail auth - jump to next external auth service
+ return 0;
+ }
+ }
+
+ # Any other checks you want to add? Add them here.
+
+ # If we've survived to this point, we're good.
+ $RT::Logger->info( (caller(0))[3],
+ "External Auth OK (",
+ $service,
+ "):",
+ $name_to_auth);
+ return 1;
+
+}
+
+
+sub CanonicalizeUserInfo {
+
+ my ($service, $key, $value) = @_;
+
+ my $found = 0;
+ my %params = (Name => undef,
+ EmailAddress => undef,
+ RealName => undef);
+
+ # Load the config
+ my $config = $RT::ExternalSettings->{$service};
+
+ # Figure out what's what
+ my $base = $config->{'base'};
+ my $filter = $config->{'filter'};
+
+ # Get the list of unique attrs we need
+ my @attrs = values(%{$config->{'attr_map'}});
+
+ # This is a bit confusing and probably broken. Something to revisit..
+ my $filter_addition = ($key && $value) ? "(". $key . "=$value)" : "";
+ if(defined($filter) && ($filter ne "()")) {
+ $filter = Net::LDAP::Filter->new( "(&" .
+ $filter .
+ $filter_addition .
+ ")"
+ );
+ } else {
+ $RT::Logger->debug( "LDAP Filter invalid or not present.");
+ }
+
+ unless ($base) {
+ $RT::Logger->critical( (caller(0))[3],
+ "No base given");
+ # Drop out to the next external information service
+ return ($found, %params);
+ }
+
+ # Get a Net::LDAP object based on the config we provide
+ my $ldap = $self->_GetBoundLdapObj($config);
+
+ # Jump to the next external information service if we can't get one,
+ # errors should be logged by _GetBoundLdapObj so we don't have to.
+ return ($found, %params) unless ($ldap);
+
+ # Do a search for them in LDAP
+ $RT::Logger->debug( "LDAP Search === ",
+ "Base:",
+ $base,
+ "== Filter:",
+ $filter->as_string,
+ "== Attrs:",
+ join(',', at attrs));
+
+ my $ldap_msg = $ldap->search(base => $base,
+ filter => $filter,
+ attrs => \@attrs);
+
+ # If we didn't get at LEAST a partial result, just die now.
+ if ($ldap_msg->code != LDAP_SUCCESS and
+ $ldap_msg->code != LDAP_PARTIAL_RESULTS) {
+ $RT::Logger->critical( (caller(0))[3],
+ ": Search for ",
+ $filter->as_string,
+ " failed: ",
+ ldap_error_name($ldap_msg->code),
+ $ldap_msg->code);
+ # $found remains as 0
+
+ # Drop out to the next external information service
+ $ldap_msg = $ldap->unbind();
+ if ($ldap_msg->code != LDAP_SUCCESS) {
+ $RT::Logger->critical( (caller(0))[3],
+ ": Could not unbind: ",
+ ldap_error_name($ldap_msg->code),
+ $ldap_msg->code);
+ }
+ undef $ldap;
+ undef $ldap_msg;
+ return ($found, %params);
+
+ } else {
+ # If there's only one match, we're good; more than one and
+ # we don't know which is the right one so we skip it.
+ if ($ldap_msg->count == 1) {
+ my $entry = $ldap_msg->first_entry();
+ foreach my $key (keys(%{$config->{'attr_map'}})) {
+ if ($RT::LdapAttrMap->{$key} eq 'dn') {
+ $params{$key} = $entry->dn();
+ } else {
+ $params{$key} =
+ ($entry->get_value($config->{'attr_map'}->{$key}))[0];
+ }
+ }
+ $found = 1;
+ } else {
+ # Drop out to the next external information service
+ $ldap_msg = $ldap->unbind();
+ if ($ldap_msg->code != LDAP_SUCCESS) {
+ $RT::Logger->critical( (caller(0))[3],
+ ": Could not unbind: ",
+ ldap_error_name($ldap_msg->code),
+ $ldap_msg->code);
+ }
+ undef $ldap;
+ undef $ldap_msg;
+ return ($found, %params);
+ }
+ }
+ $ldap_msg = $ldap->unbind();
+ if ($ldap_msg->code != LDAP_SUCCESS) {
+ $RT::Logger->critical( (caller(0))[3],
+ ": Could not unbind: ",
+ ldap_error_name($ldap_msg->code),
+ $ldap_msg->code);
+ }
+
+ undef $ldap;
+ undef $ldap_msg;
+
+ return ($found, %params);
+}
+
+# {{{ sub _GetBoundLdapObj
+
+sub _GetBoundLdapObj {
+
+ # Config as hashref
+ my $config = shift;
+
+ # Figure out what's what
+ my $ldap_server = $config->{'server'};
+ my $ldap_user = $config->{'user'};
+ my $ldap_pass = $config->{'pass'};
+ my $ldap_tls = $config->{'tls'};
+ my $ldap_ssl_ver = $config->{'ssl_version'};
+ my $ldap_args = $config->{'net_ldap_args'};
+
+ my $ldap = new Net::LDAP($ldap_server, @$ldap_args);
+
+ unless ($ldap) {
+ $RT::Logger->critical( (caller(0))[3],
+ ": Cannot connect to",
+ $ldap_server);
+ return undef;
+ }
+
+ if ($ldap_tls) {
+ $Net::SSLeay::ssl_version = $ldap_ssl_ver;
+ # Thanks to David Narayan for the fault tolerance bits
+ eval { $ldap->start_tls; };
+ if ($@) {
+ $RT::Logger->critical( (caller(0))[3],
+ "Can't start TLS: ",
+ $@);
+ return;
+ }
+
+ }
+
+ my $msg = undef;
+
+ # Can't decide whether to add a little more error checking here..
+ # Perhaps, if user && pass, else dont pass a pass etc..
+ if ($ldap_user) {
+ $msg = $ldap->bind($ldap_user, password => $ldap_pass);
+ } else {
+ $msg = $ldap->bind;
+ }
+
+ unless ($msg->code == LDAP_SUCCESS) {
+ $RT::Logger->critical( (caller(0))[3],
+ "Can't bind:",
+ ldap_error_name($msg->code),
+ $msg->code);
+ return undef;
+ } else {
+ return $ldap;
+ }
+}
+
+# }}}
+
+1;
\ No newline at end of file
diff --git a/lib/RT/User_Vendor.pm b/lib/RT/User_Vendor.pm
index 229e736..f859152 100644
--- a/lib/RT/User_Vendor.pm
+++ b/lib/RT/User_Vendor.pm
@@ -34,10 +34,8 @@
no warnings qw(redefine);
use strict;
-use DBI;
-use Net::LDAP qw(LDAP_SUCCESS LDAP_PARTIAL_RESULTS);
-use Net::LDAP::Util qw(ldap_error_name);
-use Net::LDAP::Filter;
+use RT::Authen::ExternalAuth::LDAP;
+use RT::Authen::ExternalAuth::DBI;
# We only need Net::SSLeay if one of our external services requires
# OpenSSL because it plans to use SSL or TLS to encrypt connections
@@ -66,227 +64,17 @@ sub IsExternalPassword {
# And then act accordingly depending on what type of service it is.
# Right now, there is only code for DBI and LDAP services
if ($config->{'type'} eq 'db') {
- my $db_table = $config->{'table'};
- my $db_u_field = $config->{'u_field'};
- my $db_p_field = $config->{'p_field'};
- my $db_p_enc_pkg = $config->{'p_enc_pkg'};
- my $db_p_enc_sub = $config->{'p_enc_sub'};
-
- # Set SQL query and bind parameters
- my $query = "SELECT $db_u_field,$db_p_field FROM $db_table WHERE $db_u_field=?";
- my @params = ($name_to_auth);
-
- # Uncomment this to trace basic DBI information and drop it in a log for debugging
- # DBI->trace(1,'/tmp/dbi.log');
-
- # Get DBI handle object (DBH), do SQL query, kill DBH
- my $dbh = $self->_GetBoundDBIObj($config);
- my $results_hashref = $dbh->selectall_hashref($query,$db_u_field,{}, at params);
- $dbh->disconnect();
-
- my $num_users_returned = scalar keys %$results_hashref;
- if($num_users_returned != 1) { # FAIL
- # FAIL because more than one user returned. Users MUST be unique!
- if ((scalar keys %$results_hashref) > 1) {
- $RT::Logger->info( $service,
- "AUTH FAILED",
- $name_to_auth,
- "More than one user with that username!");
- }
-
- # FAIL because no users returned. Users MUST exist!
- if ((scalar keys %$results_hashref) < 1) {
- $RT::Logger->info( $service,
- "AUTH FAILED",
- $name_to_auth,
- "User not found in database!");
- }
-
- # Drop out to next external authentication service
- next;
- }
-
- # Get the user's password from the database query result
- my $pass_from_db = $results_hashref->{$name_to_auth}->{$db_p_field};
-
- # This is the encryption package & subroutine passed in by the config file
- $RT::Logger->debug( "Encryption Package:",
- $db_p_enc_pkg);
- $RT::Logger->debug( "Encryption Subroutine:",
- $db_p_enc_sub);
-
- # Use config info to auto-load the perl package needed for password encryption
- # I know it uses a string eval - but I don't think there's a better way to do this
- # Jump to next external authentication service on failure
- eval "require $db_p_enc_pkg" or
- $RT::Logger->error("AUTH FAILED, Couldn't Load Password Encryption Package. Error: $@") && next;
-
- my $encrypt = $db_p_enc_pkg->can($db_p_enc_sub);
- if (defined($encrypt)) {
- # If the package given can perform the subroutine given, then use it to compare the
- # password given with the password pulled from the database.
- # Jump to the next external authentication service if they don't match
- if(${encrypt}->($pass_to_auth) ne $pass_from_db){
- $RT::Logger->info( $service,
- "AUTH FAILED",
- $name_to_auth,
- "Password Incorrect");
- next;
- }
- } else {
- # If the encryption package can't perform the request subroutine,
- # dump an error and jump to the next external authentication service.
- $RT::Logger->error($service,
- "AUTH FAILED",
- "The encryption package you gave me (",
- $db_p_enc_pkg,
- ") does not support the encryption method you specified (",
- $db_p_enc_sub,
- ")");
- next;
- }
-
- # Any other checks you want to add? Add them here.
-
- # If we've survived to this point, we're good.
- $RT::Logger->info( (caller(0))[3],
- "External Auth OK (",
- $service,
- "):",
- $name_to_auth);
- return 1;
+ my $success = RT::Authen::ExternalAuth::DBI->getAuth($service,$name_to_auth,$pass_to_auth);
+ return 1 if $success;
+ next;
} elsif ($config->{'type'} eq 'ldap') {
- my $base = $config->{'base'};
- my $filter = $config->{'filter'};
- my $group = $config->{'group'};
- my $group_attr = $config->{'group_attr'};
- my $attr_map = $config->{'attr_map'};
- my @attrs = ('dn');
-
- # Empty parentheses as filters cause Net::LDAP to barf.
- # We take care of this by using Net::LDAP::Filter, but
- # there's no harm in fixing this right now.
- if ($filter eq "()") { undef($filter) };
-
- # Now let's get connected
- my $ldap = $self->_GetBoundLdapObj($config);
- next unless ($ldap);
-
- $filter = Net::LDAP::Filter->new( '(&(' .
- $attr_map->{'Name'} .
- '=' .
- $self->Name .
- ')' .
- $filter .
- ')'
- );
-
- $RT::Logger->debug( "LDAP Search === ",
- "Base:",
- $base,
- "== Filter:",
- $filter->as_string,
- "== Attrs:",
- join(',', at attrs));
-
- my $ldap_msg = $ldap->search( base => $base,
- filter => $filter,
- attrs => \@attrs);
-
- unless ($ldap_msg->code == LDAP_SUCCESS || $ldap_msg->code == LDAP_PARTIAL_RESULTS) {
- $RT::Logger->debug( "search for",
- $filter->as_string,
- "failed:",
- ldap_error_name($ldap_msg->code),
- $ldap_msg->code);
- # Didn't even get a partial result - jump straight to the next external auth service
- next;
- }
-
- unless ($ldap_msg->count == 1) {
- $RT::Logger->info( $service,
- "AUTH FAILED:",
- $self->Name,
- "User not found or more than one user found");
- # We got no user, or too many users.. jump straight to the next external auth service
- next;
- }
-
- my $ldap_dn = $ldap_msg->first_entry->dn;
- $RT::Logger->debug( "Found LDAP DN:",
- $ldap_dn);
-
- # THIS bind determines success or failure on the password.
- $ldap_msg = $ldap->bind($ldap_dn, password => $pass_to_auth);
-
- unless ($ldap_msg->code == LDAP_SUCCESS) {
- $RT::Logger->info( $service,
- "AUTH FAILED",
- $self->Name,
- "(can't bind:",
- ldap_error_name($ldap_msg->code),
- $ldap_msg->code,
- ")");
- # Could not bind to the LDAP server as the user we found with the password
- # we were given, therefore the password must be wrong so we fail and
- # jump straight to the next external auth service
- next;
- }
-
- # The user is authenticated ok, but is there an LDAP Group to check?
- if ($group) {
- # If we've been asked to check a group...
- $filter = Net::LDAP::Filter->new("(${group_attr}=${ldap_dn})");
-
- $RT::Logger->debug( "LDAP Search === ",
- "Base:",
- $base,
- "== Filter:",
- $filter->as_string,
- "== Attrs:",
- join(',', at attrs));
-
- $ldap_msg = $ldap->search( base => $group,
- filter => $filter,
- attrs => \@attrs,
- scope => 'base');
-
- # And the user isn't a member:
- unless ($ldap_msg->code == LDAP_SUCCESS ||
- $ldap_msg->code == LDAP_PARTIAL_RESULTS) {
- $RT::Logger->critical( "Search for",
- $filter->as_string,
- "failed:",
- ldap_error_name($ldap_msg->code),
- $ldap_msg->code);
-
- # Fail auth - jump to next external auth service
- next;
- }
-
- unless ($ldap_msg->count == 1) {
- $RT::Logger->info( $service,
- "AUTH FAILED:",
- $self->Name);
-
- # Fail auth - jump to next external auth service
- next;
- }
- }
-
- # Any other checks you want to add? Add them here.
-
- # If we've survived to this point, we're good.
- $RT::Logger->info( (caller(0))[3],
- "External Auth OK (",
- $service,
- "):",
- $name_to_auth);
- return 1;
-
+ my $success = RT::Authen::ExternalAuth::LDAP->getAuth($service,$name_to_auth,$pass_to_auth);
+ return 1 if $success;
+ next;
+
} else {
- $RT::Logger->error("Invalid type specification in config",$service);
+ $RT::Logger->error("Invalid type specification in config for service:",$service);
}
}
@@ -418,9 +206,9 @@ sub CanonicalizeUserInfo {
$rt_attr);
next unless defined($args->{$rt_attr});
- # Else, use it as a key for LookupExternalUserInfo
+ # Else, use it as a key for GetUserInfoHash
($found, %params) =
- $self->LookupExternalUserInfo($config->{'attr_map'}->{$rt_attr},$args->{$rt_attr});
+ $self->GetUserInfoHash($service,$config->{'attr_map'}->{$rt_attr},$args->{$rt_attr});
# Don't Check any more attributes
last if $found;
@@ -456,248 +244,68 @@ sub CanonicalizeUserInfo {
# {{{ sub LookupExternalUserInfo
-=head2 LookupExternalUserInfo KEY VALUE [BASE_DN]
+=head2 GetUserInfoHash SERVICE KEY VALUE
-LookupExternalUserInfo takes a key/value pair, looks it up externally,
-and returns a params hash containing all attrs listed in the source's
-attr_map, suitable for creating an RT::User object.
+LookupExternalUserInfo takes a key/value pair and an external service
+to look it up in; looks it up and returns a params hash containing
+all attrs listed in the source's attr_map, suitable for creating
+an RT::User object.
Returns a tuple, ($found, %params)
=cut
-sub LookupExternalUserInfo {
+sub GetUserInfoHash {
my $self = shift;
- my ($key, $value) = @_;
+ my ($service,$key, $value) = @_;
- # Set up worst case return info
+ # Haven't got anything yet..
my $found = 0;
my %params = (Name => undef,
EmailAddress => undef,
RealName => undef);
- # Get the list of information services in priority order from the SiteConfig
- my @info_services = $RT::ExternalInfoPriority ? @{$RT::ExternalInfoPriority} : undef;
- foreach my $service (@info_services) {
- # Get the full configuration for the service in question
- my $config = $RT::ExternalSettings->{$service};
-
- my $valid = 0;
- my ($attr_key, $attr_value);
- my $attr_map = $config->{'attr_map'};
- while (($attr_key, $attr_value) = each %$attr_map) {
- $valid = 1 if ($key eq $attr_value);
- }
- unless ($valid){
- $RT::Logger->debug( $key,
- "is not valid attribute key (",
- $service,
- ") - Trying Next Service");
- next;
- }
-
- # Use an if/elsif structure to do a lookup with any custom code needed
- # for any given type of external service, or die if no code exists for
- # the service requested.
-
- if($config->{'type'} eq 'ldap'){
- # Figure out what's what
- my $base = $config->{'base'};
- my $filter = $config->{'filter'};
-
- # Get the list of unique attrs we need
- my @attrs = values(%{$config->{'attr_map'}});
-
- # This is a bit confusing and probably broken. Something to revisit..
- my $filter_addition = ($key && $value) ? "(". $key . "=$value)" : "";
- if(defined($filter) && ($filter ne "()")) {
- $filter = Net::LDAP::Filter->new( "(&" .
- $filter .
- $filter_addition .
- ")"
- );
- } else {
- $RT::Logger->debug( "LDAP Filter invalid or not present.");
- }
-
- unless ($base) {
- $RT::Logger->critical( (caller(0))[3],
- "No base given");
- # Drop out to the next external information service
- next;
- }
-
- # Get a Net::LDAP object based on the config we provide
- my $ldap = $self->_GetBoundLdapObj($config);
-
- # Jump to the next external information service if we can't get one,
- # errors should be logged by _GetBoundLdapObj so we don't have to.
- next unless ($ldap);
-
- # Do a search for them in LDAP
- $RT::Logger->debug( "LDAP Search === ",
- "Base:",
- $base,
- "== Filter:",
- $filter->as_string,
- "== Attrs:",
- join(',', at attrs));
-
- my $ldap_msg = $ldap->search(base => $base,
- filter => $filter,
- attrs => \@attrs);
-
- # If we didn't get at LEAST a partial result, just die now.
- if ($ldap_msg->code != LDAP_SUCCESS and
- $ldap_msg->code != LDAP_PARTIAL_RESULTS) {
- $RT::Logger->critical( (caller(0))[3],
- ": Search for ",
- $filter->as_string,
- " failed: ",
- ldap_error_name($ldap_msg->code),
- $ldap_msg->code);
- # $found remains as 0
-
- # Drop out to the next external information service
- $ldap_msg = $ldap->unbind();
- if ($ldap_msg->code != LDAP_SUCCESS) {
- $RT::Logger->critical( (caller(0))[3],
- ": Could not unbind: ",
- ldap_error_name($ldap_msg->code),
- $ldap_msg->code);
- }
- undef $ldap;
- undef $ldap_msg;
- next;
-
- } else {
- # If there's only one match, we're good; more than one and
- # we don't know which is the right one so we skip it.
- if ($ldap_msg->count == 1) {
- my $entry = $ldap_msg->first_entry();
- foreach my $key (keys(%{$config->{'attr_map'}})) {
- if ($RT::LdapAttrMap->{$key} eq 'dn') {
- $params{$key} = $entry->dn();
- } else {
- $params{$key} =
- ($entry->get_value($config->{'attr_map'}->{$key}))[0];
- }
- }
- $found = 1;
- } else {
- # Drop out to the next external information service
- $ldap_msg = $ldap->unbind();
- if ($ldap_msg->code != LDAP_SUCCESS) {
- $RT::Logger->critical( (caller(0))[3],
- ": Could not unbind: ",
- ldap_error_name($ldap_msg->code),
- $ldap_msg->code);
- }
- undef $ldap;
- undef $ldap_msg;
- next;
- }
- }
- $ldap_msg = $ldap->unbind();
- if ($ldap_msg->code != LDAP_SUCCESS) {
- $RT::Logger->critical( (caller(0))[3],
- ": Could not unbind: ",
- ldap_error_name($ldap_msg->code),
- $ldap_msg->code);
- }
-
- undef $ldap;
- undef $ldap_msg;
- last if $found;
-
- } elsif ($config->{'type'} eq 'db') {
- # Figure out what's what
- my $table = $config->{'table'};
-
- unless ($table) {
- $RT::Logger->critical( (caller(0))[3],
- "No table given");
- # Drop out to the next external information service
- next;
- }
-
- unless ($key && $value){
- $RT::Logger->critical( (caller(0))[3],
- " Nothing to look-up given");
- # Drop out to the next external information service
- next;
- }
-
- # "where" refers to WHERE section of SQL query
- my ($where_key,$where_value) = ("@{[ $key ]}",$value);
-
- # Get the list of unique attrs we need
- my %db_attrs = map {$_ => 1} values(%{$config->{'attr_map'}});
- my @attrs = keys(%db_attrs);
- my $fields = join(',', at attrs);
- my $query = "SELECT $fields FROM $table WHERE $where_key=?";
- my @bind_params = ($where_value);
-
- # Uncomment this to trace basic DBI throughput in a log
- # DBI->trace(1,'/tmp/dbi.log');
- my $dbh = $self->_GetBoundDBIObj($config);
- my $results_hashref = $dbh->selectall_hashref($query,$key,{}, at bind_params);
- $dbh->disconnect();
-
- if ((scalar keys %$results_hashref) != 1) {
- # If returned users <> 1, we have no single unique user, so prepare to die
- my $death_msg;
-
- if ((scalar keys %$results_hashref) == 0) {
- # If no user...
- $death_msg = "No User Found in External Database!";
- } else {
- # If more than one user...
- $death_msg = "More than one user found in External Database with that unique identifier!";
- }
-
- # Log the death
- $RT::Logger->info( (caller(0))[3],
- "INFO CHECK FAILED",
- "Key: $key",
- "Value: $value",
- $death_msg);
-
- # $found remains as 0
-
- # Drop out to next external information service
- next;
- }
-
- # We haven't dropped out, so DB search must have succeeded with
- # exactly 1 result. Log it, get the result and set $found to 1
- my $result = $results_hashref->{$value};
-
- # Use the result to populate %params for every key we're given in the config
- foreach my $key (keys(%{$config->{'attr_map'}})) {
- $params{$key} = ($result->{$config->{'attr_map'}->{$key}})[0];
- }
-
- $found = 1;
- last;
+ # Get the full configuration for the service in question
+ my $config = $RT::ExternalSettings->{$service};
+
+ # Check to see that the key being asked for is defined in the config's attr_map
+ my $valid = 0;
+ my ($attr_key, $attr_value);
+ my $attr_map = $config->{'attr_map'};
+ while (($attr_key, $attr_value) = each %$attr_map) {
+ $valid = 1 if ($key eq $attr_value);
+ }
+ unless ($valid){
+ $RT::Logger->debug( $key,
+ "is not valid attribute key (",
+ $service,
+ ")");
+ return ($found, %params);
+ }
+
+ # Use an if/elsif structure to do a lookup with any custom code needed
+ # for any given type of external service, or die if no code exists for
+ # the service requested.
+
+ if($config->{'type'} eq 'ldap'){
+ ($found, %params) = RT::Authen::ExternalAuth::LDAP->CanonicalizeUserInfo($service,$key,$value);
+ } elsif ($config->{'type'} eq 'db') {
+ ($found, %params) = RT::Authen::ExternalAuth::DBI->CanonicalizeUserInfo($service,$key,$value);
+ } else {
+ $RT::Logger->debug( (caller(0))[3],
+ "does not consider",
+ $service,
+ "a valid information service");
+ }
- } else {
- $RT::Logger->debug( (caller(0))[3],
- "does not consider",
- $service,
- "a valid information service");
- }
-
- # If our external service found a user, then drop out
- # We don't want to check any lower-priority info services.
- last if $found;
- }
# Why on earth do we return the same RealName, just quoted?!
# Seconded by Mike Peachey - I'd like to know that too!!
# Sod it, until it breaks something, I'm removing this line forever!
# $params{'RealName'} = "\"$params{'RealName'}\"";
+
+ # Log the info found and return it
$RT::Logger->info( (caller(0))[3],
": Returning: ",
join(", ", map {sprintf("%s: %s", $_, $params{$_})}
@@ -1005,98 +613,6 @@ sub UpdateFromExternal {
return ($updated, $msg);
}
-# {{{ sub _GetBoundLdapObj
-
-sub _GetBoundLdapObj {
- my $self = shift;
-
- # Config as hashref
- my $config = shift;
-
- # Figure out what's what
- my $ldap_server = $config->{'server'};
- my $ldap_user = $config->{'user'};
- my $ldap_pass = $config->{'pass'};
- my $ldap_tls = $config->{'tls'};
- my $ldap_ssl_ver = $config->{'ssl_version'};
- my $ldap_args = $config->{'net_ldap_args'};
-
-
-
- my $ldap = new Net::LDAP($ldap_server, @$ldap_args);
-
- unless ($ldap) {
- $RT::Logger->critical( (caller(0))[3],
- ": Cannot connect to",
- $ldap_server);
- return undef;
- }
-
- if ($ldap_tls) {
- $Net::SSLeay::ssl_version = $ldap_ssl_ver;
- # Thanks to David Narayan for the fault tolerance bits
- eval { $ldap->start_tls; };
- if ($@) {
- $RT::Logger->critical( (caller(0))[3],
- "Can't start TLS: ",
- $@);
- return;
- }
-
- }
-
- my $msg = undef;
-
- # Can't decide whether to add a little more error checking here..
- # Perhaps, if user && pass, else dont pass a pass etc..
- if ($ldap_user) {
- $msg = $ldap->bind($ldap_user, password => $ldap_pass);
- } else {
- $msg = $ldap->bind;
- }
-
- unless ($msg->code == LDAP_SUCCESS) {
- $RT::Logger->critical( (caller(0))[3],
- "Can't bind:",
- ldap_error_name($msg->code),
- $msg->code);
- return undef;
- } else {
- return $ldap;
- }
-}
-
-# }}}
-# {{{ sub _GetBoundDBIObj
-
-sub _GetBoundDBIObj {
- my $self = shift;
-
- # Config as hashref.
- my $config = shift;
-
- # Extract the relevant information from the config.
- my $db_server = $config->{'server'};
- my $db_user = $config->{'user'};
- my $db_pass = $config->{'pass'};
- my $db_database = $config->{'database'};
- my $db_port = $config->{'port'};
- my $dbi_driver = $config->{'dbi_driver'};
-
- # Use config to create a DSN line for the DBI connection
- my $dsn = "dbi:$dbi_driver:database=$db_database;host=$db_server;port=$db_port";
-
- # Now let's get connected
- my $dbh = DBI->connect($dsn, $db_user, $db_pass,{RaiseError => 1, AutoCommit => 0 })
- or die $DBI::errstr;
-
- # If we didn't die, return the DBI object handle
- # and hope it's treated sensibly and correctly
- # destroyed by the calling code
- return $dbh;
-}
-
-# }}}
1;
commit aed11f46c4bf536e39f6192f1f9f5e8256d0a8a0
Author: Mike Peachey <zordrak at cpan.org>
Date: Wed Nov 5 15:02:31 2008 +0000
* Initial refactoring of ExternalAuth done
* Next step potentially is to remove the User_Vendor.pm entirely
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@16680 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/html/Callbacks/ExternalAuth/autohandler/Auth b/html/Callbacks/ExternalAuth/autohandler/Auth
index 592de29..be79aa2 100644
--- a/html/Callbacks/ExternalAuth/autohandler/Auth
+++ b/html/Callbacks/ExternalAuth/autohandler/Auth
@@ -36,22 +36,23 @@ unless ($session{'CurrentUser'}) {
# Unless we have loaded a valid user with a UserID
unless ($session{'CurrentUser'}->Id) {
- # Start with a new SystemUser
- my $UserObj = RT::User->new($RT::SystemUser);
- # Set the user's name to the one we were given
- my ($val, $msg) = $UserObj->SetName($user);
-
- # If a password was given on the login page, validate it
- if (defined($pass)) {
- $password_validated = $UserObj->IsPassword($pass);
+ # Check if user exists externally - autocreate user if it does
+ my $user_exists_externally = 0;
+ my @auth_services = @$RT::ExternalAuthPriority;
+ foreach my $service (@auth_services) {
+ my $config = $RT::Settings->{$service};
+ if ($config->{'type'} eq 'db') {
+ $user_exists_externally = RT::Authen::ExternalAuth::DBI->UserExists($service,$user);
+ last if $user_exists_externally;
+ } elsif ($config->{'type'} eq 'ldap') {
+ $user_exists_externally = RT::Authen::ExternalAuth::LDAP->UserExists($service,$user);
+ last if $user_exists_externally;
+ } else {
+ $RT::Logger->error("Invalid type specification in config for service:",$service);
+ }
}
- # If the password was validated successfully
- # start the autocreation process to create the user
- # permanently in RT
- if ($password_validated) {
- ### If there were a standard param to check for whether or not we
- ### should autocreate authenticated users, we'd check it here.
+ if($user_exists_externally){
my ($val, $msg) =
$UserObj->Create(%{ref($RT::AutoCreate) ? $RT::AutoCreate : {}},
Name => $user,
@@ -69,12 +70,21 @@ unless ($session{'CurrentUser'}) {
$user_autocreated = 1;
}
- # If we autocreated a user, then load the user as the CurrentUser in $session
- # To RT, this means we have a valid, authenticated user
- if ($UserObj->Id) {
- my ($ret, $msg) = $session{'CurrentUser'}->Load($user);
- unless ($ret) {
- $RT::Logger->error("Couldn't load user $user: $msg");
+ my ($val, $msg) = $UserObj->SetName($user);
+
+ # If a password was given on the login page, validate it
+ if (defined($pass)) {
+ $password_validated = $UserObj->IsPassword($pass);
+ }
+
+ if($password_validated) {
+ # If we autocreated a user, then load the user as the CurrentUser in $session
+ # To RT, this means we have a valid, authenticated user
+ if ($UserObj->Id) {
+ my ($ret, $msg) = $session{'CurrentUser'}->Load($user);
+ unless ($ret) {
+ $RT::Logger->error("Couldn't load user $user: $msg");
+ }
}
}
}
diff --git a/lib/RT/Authen/ExternalAuth/DBI.pm b/lib/RT/Authen/ExternalAuth/DBI.pm
index f3555aa..4c8d034 100644
--- a/lib/RT/Authen/ExternalAuth/DBI.pm
+++ b/lib/RT/Authen/ExternalAuth/DBI.pm
@@ -1,7 +1,7 @@
package RT::Authen::ExternalAuth::DBI;
use DBI;
-sub getAuth {
+sub GetAuth {
my ($service, $username, $password) = @_;
@@ -102,7 +102,7 @@ sub getAuth {
return 1;
}
-sub FindUserThenReturnInfo {
+sub CanonicalizeUSerInfo {
my ($service, $key, $value) = @_;
@@ -186,6 +186,128 @@ sub FindUserThenReturnInfo {
return ($found, %params);
}
+sub UserExists {
+
+ my ($username,$service) = @_;
+ my $config = $RT::ExternalSettings->{$service};
+ my $table = $config->{'table'};
+ my $u_field = $config->{'u_field'};
+ my $query = "SELECT $u_field FROM $table WHERE $u_field=?";
+ my @bind_params = ($username);
+
+ # Uncomment this to do a basic trace on DBI information and log it
+ # DBI->trace(1,'/tmp/dbi.log');
+
+ # Get DBI Object, do the query, disconnect
+ my $dbh = $self->_GetBoundDBIObj($config);
+ my $results_hashref = $dbh->selectall_hashref($query,$u_field,{}, at bind_params);
+ $dbh->disconnect();
+
+ my $num_of_results = scalar keys %$results_hashref;
+
+ if ($num_of_results > 1) {
+ # If more than one result returned, die because we the username field should be unique!
+ $RT::Logger->debug( "Disable Check Failed :: (",
+ $service,
+ ")",
+ $username,
+ "More than one user with that username!");
+ return 0;
+ } elsif ($num_of_results < 1) {
+ # If 0 or negative integer, no user found or major failure
+ $RT::Logger->debug( "Disable Check Failed :: (",
+ $service,
+ ")",
+ $username,
+ "User not found");
+ return 0;
+ }
+
+ # Number of results is exactly one, so we found the user we were looking for
+ return 1;
+}
+
+sub UserDisabled {
+
+ my ($username,$service) = @_;
+
+ # FIRST, check that the user exists in the DBI service
+ unless UserExists($username,$service) {
+ $RT::Logger->debug("User (",$username,") doesn't exist! - Assuming not disabled for the purposes of disable checking";
+ return 0;
+ }
+
+ # Get the necessary config info
+ my $config = $RT::ExternalSettings->{$service};
+ my $table = $config->{'table'};
+ my $u_field = $config->{'u_field'};
+ my $disable_field = $config->{'d_field'};
+ my $disable_values_list = $config->{'d_values'};
+
+ unless ($disable_field) {
+ # If we don't know how to check for disabled users, consider them all enabled.
+ $RT::Logger->debug("No d_field specified for this DBI service (",
+ $service,
+ "), so considering all users enabled");
+ return 0;
+ }
+
+ my $query = "SELECT $u_field,$disable_field FROM $table WHERE $u_field=?";
+ my @bind_params = ($username);
+
+ # Uncomment this to do a basic trace on DBI information and log it
+ # DBI->trace(1,'/tmp/dbi.log');
+
+ # Get DBI Object, do the query, disconnect
+ my $dbh = $self->_GetBoundDBIObj($config);
+ my $results_hashref = $dbh->selectall_hashref($query,$u_field,{}, at bind_params);
+ $dbh->disconnect();
+
+ my $num_of_results = scalar keys %$results_hashref;
+
+ if ($num_of_results > 1) {
+ # If more than one result returned, die because we the username field should be unique!
+ $RT::Logger->debug( "Disable Check Failed :: (",
+ $service,
+ ")",
+ $username,
+ "More than one user with that username! - Assuming not disabled");
+ # Drop out to next service for an info check
+ return 0;
+ } elsif ($num_of_results < 1) {
+ # If 0 or negative integer, no user found or major failure
+ $RT::Logger->debug( "Disable Check Failed :: (",
+ $service,
+ ")",
+ $username,
+ "User not found - Assuming not disabled");
+ # Drop out to next service for an info check
+ return 0;
+ } else {
+ # otherwise all should be well
+
+ # $user_db_disable_value = The value for "disabled" returned from the DB
+ my $user_db_disable_value = $results_hashref->{$username}->{$disable_field};
+
+ # For each of the values in the (list of values that we consider to mean the user is disabled)..
+ foreach my $disable_value (@{$disable_values_list}){
+ $RT::Logger->debug( "DB Disable Check:",
+ "User's Val is $user_db_disable_value,",
+ "Checking against: $disable_value");
+
+ # If the value from the DB matches a value from the list, the user is disabled.
+ if ($user_db_disable_value eq $disable_value) {
+ return 1;
+ }
+ }
+
+ # If we've not returned yet, the user can't be disabled
+ return 0;
+ }
+ $RT::Logger->crit("It is seriously not possible to run this code.. what the hell did you do?!");
+ return 0;
+}
+
# {{{ sub _GetBoundDBIObj
sub _GetBoundDBIObj {
diff --git a/lib/RT/Authen/ExternalAuth/LDAP.pm b/lib/RT/Authen/ExternalAuth/LDAP.pm
index c2b92ef..0e4a9c9 100644
--- a/lib/RT/Authen/ExternalAuth/LDAP.pm
+++ b/lib/RT/Authen/ExternalAuth/LDAP.pm
@@ -3,7 +3,7 @@ use Net::LDAP qw(LDAP_SUCCESS LDAP_PARTIAL_RESULTS);
use Net::LDAP::Util qw(ldap_error_name);
use Net::LDAP::Filter;
-sub getAuth {
+sub GetAuth {
my ($service, $username, $password) = @_;
@@ -264,6 +264,153 @@ sub CanonicalizeUserInfo {
return ($found, %params);
}
+sub UserExists {
+
+ my ($username,$service) = @_;
+ my $config = $RT::ExternalSettings->{$service};
+
+ my $base = $config->{'base'};
+ my $filter = $config->{'filter'};
+
+ # While LDAP filters must be surrounded by parentheses, an empty set
+ # of parentheses is an invalid filter and will cause failure
+ # This shouldn't matter since we are now using Net::LDAP::Filter below,
+ # but there's no harm in doing this to be sure
+ if ($filter eq "()") { undef($filter) };
+
+ if (defined($config->{'attr_map'}->{'Name'})) {
+ # Construct the complex filter
+ $filter = Net::LDAP::Filter->new( '(&' .
+ $filter .
+ '(' .
+ $config->{'attr_map'}->{'Name'} .
+ '=' .
+ $username .
+ '))'
+ );
+ }
+
+ my $ldap = $self->_GetBoundLdapObj($config);
+ next unless $ldap;
+
+ my @attrs = values(%{$config->{'attr_map'}});
+
+ # Check that the user exists in the LDAP service
+ $RT::Logger->debug( "LDAP Search === ",
+ "Base:",
+ $base,
+ "== Filter:",
+ $filter->as_string,
+ "== Attrs:",
+ join(',', at attrs));
+
+ my $user_found = $ldap->search( base => $base,
+ filter => $filter,
+ attrs => \@attrs);
+
+ if($user_found->count < 1) {
+ # If 0 or negative integer, no user found or major failure
+ $RT::Logger->debug( "User Check Failed :: (",
+ $service,
+ ")",
+ $username,
+ "User not found");
+ return 0;
+ } elsif ($user_found->count > 1) {
+ # If more than one result returned, die because we the username field should be unique!
+ $RT::Logger->debug( "User Check Failed :: (",
+ $service,
+ ")",
+ $username,
+ "More than one user with that username!");
+ return 0;
+ }
+ undef $user_found;
+
+ # If we havent returned now, there must be a valid user.
+ return 1;
+}
+
+sub UserDisabled {
+
+ my ($username,$service) = @_;
+
+ # FIRST, check that the user exists in the LDAP service
+ unless UserExists($username,$service) {
+ $RT::Logger->debug("User (",$username,") doesn't exist! - Assuming not disabled for the purposes of disable checking";
+ return 0;
+ }
+
+ my $config = $RT::ExternalSettings->{$service};
+ my $base = $config->{'base'};
+ my $filter = $config->{'filter'};
+ my $d_filter = $config->{'d_filter'};
+ my $search_filter;
+
+ # While LDAP filters must be surrounded by parentheses, an empty set
+ # of parentheses is an invalid filter and will cause failure
+ # This shouldn't matter since we are now using Net::LDAP::Filter below,
+ # but there's no harm in doing this to be sure
+ if ($filter eq "()") { undef($filter) };
+ if ($d_filter eq "()") { undef($d_filter) };
+
+ unless ($d_filter) {
+ # If we don't know how to check for disabled users, consider them all enabled.
+ $RT::Logger->debug("No d_filter specified for this LDAP service (",
+ $service,
+ "), so considering all users enabled");
+ return 0;
+ }
+
+ if (defined($config->{'attr_map'}->{'Name'})) {
+ # Construct the complex filter
+ $search_filter = Net::LDAP::Filter->new( '(&' .
+ $filter .
+ $d_filter .
+ '(' .
+ $config->{'attr_map'}->{'Name'} .
+ '=' .
+ $username .
+ '))'
+ );
+ } else {
+ $RT::Logger->debug("You haven't specified an LDAP attribute to match the RT \"Name\" attribute for this service (",
+ $service,
+ "), so it's impossible look up the disabled status of this user (",
+ $username,
+ ") so I'm just going to assume the user is not disabled");
+ return 0;
+
+ }
+
+ my $ldap = $self->_GetBoundLdapObj($config);
+ next unless $ldap;
+
+ # We only need the UID for confirmation now,
+ # the other information would waste time and bandwidth
+ @attrs = ('uid');
+
+ $RT::Logger->debug( "LDAP Search === ",
+ "Base:",
+ $base,
+ "== Filter:",
+ $search_filter->as_string,
+ "== Attrs:",
+ join(',', at attrs));
+
+ my $disabled_users = $ldap->search(base => $base,
+ filter => $search_filter,
+ attrs => \@attrs);
+ # If ANY results are returned,
+ # we are going to assume the user should be disabled
+ if ($disabled_users->count) {
+ undef $disabled_users;
+ return 1;
+ } else {
+ undef $disabled_users;
+ return 0;
+ }
+}
# {{{ sub _GetBoundLdapObj
sub _GetBoundLdapObj {
diff --git a/lib/RT/User_Vendor.pm b/lib/RT/User_Vendor.pm
index f859152..477dba0 100644
--- a/lib/RT/User_Vendor.pm
+++ b/lib/RT/User_Vendor.pm
@@ -1,36 +1,9 @@
-### User_Local.pm overlay for External Service authentication and information
-###
-### CREDITS
+### User_Vendor.pm
+# Overlay for RT::User object as part of RT::Authen::ExternalAuth
#
-# Based on User_Local.pm for LDAP created by JimMeyer and found at:
+# Originally based on User_Local.pm for LDAP created by Jim Meyer (purp at acm.org) and found at:
# http://wiki.bestpractical.com/view/LdapUserLocalOverlay
-#
-# His Credits:
-#
-# IsLDAPPassword() based on implementation of IsPassword() found at:
-#
-# http://www.justatheory.com/computers/programming/perl/rt/User_Local.pm.ldap
-#
-# Author's credits:
-# Modification Originally by Marcelo Bartsch <bartschm_cl at hotmail.com>
-# Update by Stewart James <stewart.james at vu.edu.au for rt3.
-# Update by David Wheeler <david at kineticode.com> for TLS and
-# Group membership support.
-#
-#
-# CaonicalizeEmailAddress(), CanonicalizeUserInfo(), and LookupExternalInfo()
-# based on work by Phillip Cole (phillip d cole @ uk d coltgroup d com)
-# found at:
-#
-# http://wiki.bestpractical.com/view/AutoCreateAndCanonicalizeUserInfo
-#
-# His credits:
-# based on CurrentUser_Local.pm and much help from the mailing lists
-#
-# All integrated, refactored, and updated by Jim Meyer (purp at acm.org)
-#
-# Modified to provide alternate external services authentication and information for rt3
-# as part of RT::Authen::ExternalAuth by Mike Peachey (mike.peachey at jennic.com)
+
no warnings qw(redefine);
use strict;
@@ -64,12 +37,12 @@ sub IsExternalPassword {
# And then act accordingly depending on what type of service it is.
# Right now, there is only code for DBI and LDAP services
if ($config->{'type'} eq 'db') {
- my $success = RT::Authen::ExternalAuth::DBI->getAuth($service,$name_to_auth,$pass_to_auth);
+ my $success = RT::Authen::ExternalAuth::DBI->GetAuth($service,$name_to_auth,$pass_to_auth);
return 1 if $success;
next;
} elsif ($config->{'type'} eq 'ldap') {
- my $success = RT::Authen::ExternalAuth::LDAP->getAuth($service,$name_to_auth,$pass_to_auth);
+ my $success = RT::Authen::ExternalAuth::LDAP->GetAuth($service,$name_to_auth,$pass_to_auth);
return 1 if $success;
next;
@@ -179,8 +152,10 @@ sub CanonicalizeUserInfo {
my $args = shift;
my $found = 0;
- my %params = ();
-
+ my %params = (Name => undef,
+ EmailAddress => undef,
+ RealName => undef);
+
$RT::Logger->debug( (caller(0))[3],
"called by",
caller,
@@ -201,15 +176,52 @@ sub CanonicalizeUserInfo {
# For each attr we've been told to canonicalize in the match list
foreach my $rt_attr (@{$config->{'attr_match_list'}}) {
- # Jump to the next attr if it's not an RT attr passed in $args
- $RT::Logger->debug( "Attempting to use this canonicalization key:",
- $rt_attr);
- next unless defined($args->{$rt_attr});
-
- # Else, use it as a key for GetUserInfoHash
- ($found, %params) =
- $self->GetUserInfoHash($service,$config->{'attr_map'}->{$rt_attr},$args->{$rt_attr});
-
+ # Jump to the next attr in $args if this one isn't in the attr_match_list
+ $RT::Logger->debug( "Attempting to use this canonicalization key:",$rt_attr);
+ unless defined($args->{$rt_attr}) {
+ $RT::Logger->debug("This attribute (",
+ $rt_attr,
+ ") is not defined in the attr_match_list for this service (",
+ $service,
+ ")");
+ next;
+ }
+
+ # Else, use it as a canonicalization key and lookup the user info
+ my $key = $config->{'attr_map'}->{$rt_attr};
+ my $value = $args->{$rt_attr};
+
+ # Check to see that the key being asked for is defined in the config's attr_map
+ my $valid = 0;
+ my ($attr_key, $attr_value);
+ my $attr_map = $config->{'attr_map'};
+ while (($attr_key, $attr_value) = each %$attr_map) {
+ $valid = 1 if ($key eq $attr_value);
+ }
+ unless ($valid){
+ $RT::Logger->debug( "This key (",
+ $key,
+ "is not a valid attribute key (",
+ $service,
+ ")");
+ next;
+ }
+
+ # Use an if/elsif structure to do a lookup with any custom code needed
+ # for any given type of external service, or die if no code exists for
+ # the service requested.
+
+ if($config->{'type'} eq 'ldap'){
+ ($found, %params) = RT::Authen::ExternalAuth::LDAP->CanonicalizeUserInfo($service,$key,$value);
+ } elsif ($config->{'type'} eq 'db') {
+ ($found, %params) = RT::Authen::ExternalAuth::DBI->CanonicalizeUserInfo($service,$key,$value);
+ } else {
+ $RT::Logger->debug( (caller(0))[3],
+ "does not consider",
+ $service,
+ "a valid information service");
+ }
+
# Don't Check any more attributes
last if $found;
}
@@ -242,85 +254,6 @@ sub CanonicalizeUserInfo {
}
# }}}
-# {{{ sub LookupExternalUserInfo
-
-=head2 GetUserInfoHash SERVICE KEY VALUE
-
-LookupExternalUserInfo takes a key/value pair and an external service
-to look it up in; looks it up and returns a params hash containing
-all attrs listed in the source's attr_map, suitable for creating
-an RT::User object.
-
-Returns a tuple, ($found, %params)
-
-=cut
-
-sub GetUserInfoHash {
- my $self = shift;
- my ($service,$key, $value) = @_;
-
- # Haven't got anything yet..
- my $found = 0;
- my %params = (Name => undef,
- EmailAddress => undef,
- RealName => undef);
-
- # Get the full configuration for the service in question
- my $config = $RT::ExternalSettings->{$service};
-
- # Check to see that the key being asked for is defined in the config's attr_map
- my $valid = 0;
- my ($attr_key, $attr_value);
- my $attr_map = $config->{'attr_map'};
- while (($attr_key, $attr_value) = each %$attr_map) {
- $valid = 1 if ($key eq $attr_value);
- }
- unless ($valid){
- $RT::Logger->debug( $key,
- "is not valid attribute key (",
- $service,
- ")");
- return ($found, %params);
- }
-
- # Use an if/elsif structure to do a lookup with any custom code needed
- # for any given type of external service, or die if no code exists for
- # the service requested.
-
- if($config->{'type'} eq 'ldap'){
- ($found, %params) = RT::Authen::ExternalAuth::LDAP->CanonicalizeUserInfo($service,$key,$value);
- } elsif ($config->{'type'} eq 'db') {
- ($found, %params) = RT::Authen::ExternalAuth::DBI->CanonicalizeUserInfo($service,$key,$value);
- } else {
- $RT::Logger->debug( (caller(0))[3],
- "does not consider",
- $service,
- "a valid information service");
- }
-
-
- # Why on earth do we return the same RealName, just quoted?!
- # Seconded by Mike Peachey - I'd like to know that too!!
- # Sod it, until it breaks something, I'm removing this line forever!
- # $params{'RealName'} = "\"$params{'RealName'}\"";
-
-
- # Log the info found and return it
- $RT::Logger->info( (caller(0))[3],
- ": Returning: ",
- join(", ", map {sprintf("%s: %s", $_, $params{$_})}
- sort(keys(%params))));
-
- $RT::Logger->debug( (caller(0))[3],
- "No user was found this time"
- ) if ($found == 0);
-
- return ($found, %params);
-}
-
-# }}}
-
-
sub UpdateFromExternal {
my $self = shift;
@@ -329,7 +262,7 @@ sub UpdateFromExternal {
my $updated = 0;
my $msg = "User NOT updated";
- my $name_to_update = $self->Name;
+ my $username = $self->Name;
my $user_disabled = 0;
# Get the list of information service names requested by user.
@@ -346,177 +279,37 @@ sub UpdateFromExternal {
my $config = $RT::ExternalSettings->{$service};
# If the config doesn't exist, don't bother doing anything, skip to next in list.
- next unless defined($config);
+ unless defined($config) {
+ $RT::Logger->debug("You haven't defined a configuration for the service named \"",
+ $service,
+ "\" so I'm not going to try to get user information from it. Skipping...");
+ next;
+ }
# If it's a DBI config:
if ($config->{'type'} eq 'db') {
- # Get the necessary config info
- my $table = $config->{'table'};
- my $u_field = $config->{'u_field'};
- my $disable_field = $config->{'d_field'};
- my $disable_values_list = $config->{'d_values'};
-
- # Only lookup disable information from the DB if a disable_field has been set
- if ($disable_field) {
- my $query = "SELECT $u_field,$disable_field FROM $table WHERE $u_field=?";
- my @bind_params = ($name_to_update);
-
- # Uncomment this to do a basic trace on DBI information and log it
- # DBI->trace(1,'/tmp/dbi.log');
-
- # Get DBI Object, do the query, disconnect
- my $dbh = $self->_GetBoundDBIObj($config);
- my $results_hashref = $dbh->selectall_hashref($query,$u_field,{}, at bind_params);
- $dbh->disconnect();
-
- my $num_of_results = scalar keys %$results_hashref;
-
- if ($num_of_results > 1) {
- # If more than one result returned, die because we the username field should be unique!
- $RT::Logger->debug( "Disable Check Failed :: (",
- $service,
- ")",
- $name_to_update,
- "More than one user with that username!");
- # Drop out to next service for an info check
- next;
- } elsif ($num_of_results < 1) {
- # If 0 or negative integer, no user found or major failure
- $RT::Logger->debug( "Disable Check Failed :: (",
- $service,
- ")",
- $name_to_update,
- "User not found");
- # Drop out to next service for an info check
- next;
- } else {
- # otherwise all should be well
-
- # $user_db_disable_value = The value for "disabled" returned from the DB
- my $user_db_disable_value = $results_hashref->{$name_to_update}->{$disable_field};
-
- # For each of the values in the (list of values that we consider to mean the user is disabled)..
- foreach my $disable_value (@{$disable_values_list}){
- $RT::Logger->debug( "DB Disable Check:",
- "User's Val is $user_db_disable_value,",
- "Checking against: $disable_value");
-
- # If the value from the DB matches a value from the list, the user is disabled.
- if ($user_db_disable_value eq $disable_value) {
- $user_disabled = 1;
- }
- }
- }
- }
-
- # If we havent been dropped out by a "next;" by now,
- # then this will be the authoritative service
- } elsif ($config->{'type'} eq 'ldap') {
-
- my $base = $config->{'base'};
- my $filter = $config->{'filter'};
- my $disable_filter = $config->{'d_filter'};
-
- my ($u_filter,$d_filter);
-
- # While LDAP filters must be surrounded by parentheses, an empty set
- # of parentheses is an invalid filter and will cause failure
- # This shouldn't matter since we are now using Net::LDAP::Filter below,
- # but there's no harm in doing this to be sure
- if ($filter eq "()") { undef($filter) };
- if ($disable_filter eq "()") { undef($disable_filter) };
-
- unless ($disable_filter) {
- $RT::Logger->error("You haven't specified a d_filter in your configuration. Not specifying a d_filter usually results in all users being marked as disabled and being unable to log in");
- }
-
- if (defined($config->{'attr_map'}->{'Name'})) {
- # Construct the complex filter
- $disable_filter = Net::LDAP::Filter->new( '(&' .
- $filter .
- $disable_filter .
- '(' .
- $config->{'attr_map'}->{'Name'} .
- '=' .
- $self->Name .
- '))'
- );
- $filter = Net::LDAP::Filter->new( '(&' .
- $filter .
- '(' .
- $config->{'attr_map'}->{'Name'} .
- '=' .
- $self->Name .
- '))'
- );
- }
-
- my $ldap = $self->_GetBoundLdapObj($config);
- next unless $ldap;
-
- my @attrs = values(%{$config->{'attr_map'}});
-
- # FIRST, check that the user exists in the LDAP service
- $RT::Logger->debug( "LDAP Search === ",
- "Base:",
- $base,
- "== Filter:",
- $filter->as_string,
- "== Attrs:",
- join(',', at attrs));
-
- my $user_found = $ldap->search( base => $base,
- filter => $filter,
- attrs => \@attrs);
-
- if($user_found->count < 1) {
- # If 0 or negative integer, no user found or major failure
- $RT::Logger->debug( "Disable Check Failed :: (",
+ unless RT::Authen::ExternalAuth::DBI->UserExists($username,$service) {
+ $RT::Logger->debug("User (",
+ $username,
+ ") doesn't exist in service (",
$service,
- ")",
- $name_to_update,
- "User not found");
- # Drop out to next service for an info check
- next;
- } elsif ($user_found->count > 1) {
- # If more than one result returned, die because we the username field should be unique!
- $RT::Logger->debug( "Disable Check Failed :: (",
- $service,
- ")",
- $name_to_update,
- "More than one user with that username!");
- # Drop out to next service for an info check
+ ") - Cannot update information - Skipping...");
next;
}
- undef $user_found;
-
- # SECOND, now we know the user exists in the service,
- # check if they are returned in a search for disabled users
+ $user_disabled = RT::Authen::ExternalAuth::DBI->UserDisabled($username,$service);
- # We only need the UID for confirmation now,
- # the other information would waste time and bandwidth
- @attrs = ('uid');
+ } elsif ($config->{'type'} eq 'ldap') {
- $RT::Logger->debug( "LDAP Search === ",
- "Base:",
- $base,
- "== Filter:",
- $disable_filter->as_string,
- "== Attrs:",
- join(',', at attrs));
-
- my $disabled_users = $ldap->search(base => $base,
- filter => $disable_filter,
- attrs => \@attrs);
- # If ANY results are returned,
- # we are going to assume the user should be disabled
- if ($disabled_users->count) {
- $user_disabled = 1;
+ unless RT::Authen::ExternalAuth::LDAP->UserExists($username,$service) {
+ $RT::Logger->debug("User (",
+ $username,
+ ") doesn't exist in service (",
+ $service,
+ ") - Cannot update information - Skipping...");
+ next;
}
-
- # If we havent been dropped out by a "next;" by now,
- # then this will be the authoritative service
+ $user_disabled = RT::Authen::ExternalAuth::LDAP->UserDisabled($username,$service);
} else {
# The type of external service doesn't currently have any methods associated with it. Or it's a typo.
@@ -541,7 +334,7 @@ sub UpdateFromExternal {
# Load the user inside an RT::SystemUser so you can set their
# information no matter who they are or what permissions they have
my $UserObj = RT::User->new($RT::SystemUser);
- $UserObj->Load($name_to_update);
+ $UserObj->Load($username);
# If user is disabled, set the RT::Principle to disabled and return out of the function.
# I think it's a waste of time and energy to update a user's information if they are disabled
@@ -556,24 +349,24 @@ sub UpdateFromExternal {
# Make sure principle is disabled in RT
my ($val, $message) = $UserObj->SetDisabled(1);
# Log what has happened
- $RT::Logger->info("DISABLED user ",
- $name_to_update,
- "per External Service",
+ $RT::Logger->info("User marked as DISABLED (",
+ $username,
+ ") per External Service",
"($val, $message)\n");
$msg = "User disabled";
} else {
# Make sure principle is not disabled in RT
my ($val, $message) = $UserObj->SetDisabled(0);
# Log what has happened
- $RT::Logger->info("ENABLED user ",
- $name_to_update,
- "per External Service",
+ $RT::Logger->info("User marked as ENABLED (",
+ $username,
+ ") per External Service",
"($val, $message)\n");
# Update their info from external service using the username as the lookup key
# CanonicalizeUserInfo will work out for itself which service to use
# Passing it a service instead could break other RT code
- my %args = (Name => $name_to_update);
+ my %args = (Name => $username);
$self->CanonicalizeUserInfo(\%args);
# For each piece of information returned by CanonicalizeUserInfo,
@@ -598,9 +391,9 @@ sub UpdateFromExternal {
# Confirm update success
$updated = 1;
- $RT::Logger->debug( "UPDATED user ",
- $name_to_update,
- "from External Service\n");
+ $RT::Logger->debug( "UPDATED user (",
+ $username,
+ ") from External Service\n");
$msg = 'User updated';
# Just in case we're not the last iteration of the foreach,
commit a1e8c5d37878c6ceaad7d38c4d7e0c7096fd95be
Author: Mike Peachey <zordrak at cpan.org>
Date: Wed Nov 5 15:16:32 2008 +0000
Basic Syntax fixes
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@16681 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/lib/RT/Authen/ExternalAuth/DBI.pm b/lib/RT/Authen/ExternalAuth/DBI.pm
index 4c8d034..72bd207 100644
--- a/lib/RT/Authen/ExternalAuth/DBI.pm
+++ b/lib/RT/Authen/ExternalAuth/DBI.pm
@@ -232,8 +232,8 @@ sub UserDisabled {
my ($username,$service) = @_;
# FIRST, check that the user exists in the DBI service
- unless UserExists($username,$service) {
- $RT::Logger->debug("User (",$username,") doesn't exist! - Assuming not disabled for the purposes of disable checking";
+ unless(UserExists($username,$service)) {
+ $RT::Logger->debug("User (",$username,") doesn't exist! - Assuming not disabled for the purposes of disable checking");
return 0;
}
@@ -338,4 +338,4 @@ sub _GetBoundDBIObj {
# }}}
-1;
\ No newline at end of file
+1;
diff --git a/lib/RT/Authen/ExternalAuth/LDAP.pm b/lib/RT/Authen/ExternalAuth/LDAP.pm
index 0e4a9c9..f715f65 100644
--- a/lib/RT/Authen/ExternalAuth/LDAP.pm
+++ b/lib/RT/Authen/ExternalAuth/LDAP.pm
@@ -54,7 +54,7 @@ sub GetAuth {
ldap_error_name($ldap_msg->code),
$ldap_msg->code);
# Didn't even get a partial result - jump straight to the next external auth service
- retun 0;
+ return 0;
}
unless ($ldap_msg->count == 1) {
@@ -336,8 +336,8 @@ sub UserDisabled {
my ($username,$service) = @_;
# FIRST, check that the user exists in the LDAP service
- unless UserExists($username,$service) {
- $RT::Logger->debug("User (",$username,") doesn't exist! - Assuming not disabled for the purposes of disable checking";
+ unless(UserExists($username,$service)) {
+ $RT::Logger->debug("User (",$username,") doesn't exist! - Assuming not disabled for the purposes of disable checking");
return 0;
}
@@ -471,4 +471,4 @@ sub _GetBoundLdapObj {
# }}}
-1;
\ No newline at end of file
+1;
diff --git a/lib/RT/User_Vendor.pm b/lib/RT/User_Vendor.pm
index 477dba0..60818d7 100644
--- a/lib/RT/User_Vendor.pm
+++ b/lib/RT/User_Vendor.pm
@@ -178,7 +178,7 @@ sub CanonicalizeUserInfo {
foreach my $rt_attr (@{$config->{'attr_match_list'}}) {
# Jump to the next attr in $args if this one isn't in the attr_match_list
$RT::Logger->debug( "Attempting to use this canonicalization key:",$rt_attr);
- unless defined($args->{$rt_attr}) {
+ unless(defined($args->{$rt_attr})) {
$RT::Logger->debug("This attribute (",
$rt_attr,
") is not defined in the attr_match_list for this service (",
@@ -279,7 +279,7 @@ sub UpdateFromExternal {
my $config = $RT::ExternalSettings->{$service};
# If the config doesn't exist, don't bother doing anything, skip to next in list.
- unless defined($config) {
+ unless(defined($config)) {
$RT::Logger->debug("You haven't defined a configuration for the service named \"",
$service,
"\" so I'm not going to try to get user information from it. Skipping...");
@@ -289,7 +289,7 @@ sub UpdateFromExternal {
# If it's a DBI config:
if ($config->{'type'} eq 'db') {
- unless RT::Authen::ExternalAuth::DBI->UserExists($username,$service) {
+ unless(RT::Authen::ExternalAuth::DBI->UserExists($username,$service)) {
$RT::Logger->debug("User (",
$username,
") doesn't exist in service (",
@@ -301,7 +301,7 @@ sub UpdateFromExternal {
} elsif ($config->{'type'} eq 'ldap') {
- unless RT::Authen::ExternalAuth::LDAP->UserExists($username,$service) {
+ unless(RT::Authen::ExternalAuth::LDAP->UserExists($username,$service)) {
$RT::Logger->debug("User (",
$username,
") doesn't exist in service (",
commit 3d87a3cf15eee88df8c66d8a78d08404bce17893
Author: Mike Peachey <zordrak at cpan.org>
Date: Wed Nov 5 16:29:05 2008 +0000
RT::Authen::ExternalAuth - package updates, MANIFEST etc. Version changed to 0.07_01, although admittedly still a while away
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@16682 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/MANIFEST b/MANIFEST
index b2d2831..d071315 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -11,6 +11,8 @@ inc/Module/Install/RTx.pm
inc/Module/Install/Win32.pm
inc/Module/Install/WriteAll.pm
lib/RT/Authen/ExternalAuth.pm
+lib/RT/Authen/ExternalAuth/DBI.pm
+lib/RT/Authen/ExternalAuth/LDAP.pm
lib/RT/User_Vendor.pm
LICENSE
Makefile.PL
diff --git a/Makefile.PL b/Makefile.PL
index 382d40f..ad8b320 100755
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -8,11 +8,16 @@ author('Mike Peachey <zordrak at cpan.org>');
all_from('lib/RT/Authen/ExternalAuth.pm');
requires('RT');
-requires('Net::LDAP');
features(
'SSL LDAP Connections' => [
-default => 0,
- 'Net::SSLeay' => 0]
+ 'Net::SSLeay' => 0],
+ 'External LDAP Sources' => [
+ -default => 1,
+ 'Net::LDAP' => 0],
+ 'External DBI Sources' => [
+ -default => 1,
+ 'DBI' => 0]
);
&WriteAll;
diff --git a/lib/RT/Authen/ExternalAuth.pm b/lib/RT/Authen/ExternalAuth.pm
index 5406056..b3c9ff9 100644
--- a/lib/RT/Authen/ExternalAuth.pm
+++ b/lib/RT/Authen/ExternalAuth.pm
@@ -1,6 +1,6 @@
package RT::Authen::ExternalAuth;
-our $VERSION = '0.06';
+our $VERSION = '0.07_01';
=head1 NAME
diff --git a/lib/RT/Authen/ExternalAuth/DBI.pm b/lib/RT/Authen/ExternalAuth/DBI.pm
index 72bd207..d263142 100644
--- a/lib/RT/Authen/ExternalAuth/DBI.pm
+++ b/lib/RT/Authen/ExternalAuth/DBI.pm
@@ -102,7 +102,7 @@ sub GetAuth {
return 1;
}
-sub CanonicalizeUSerInfo {
+sub CanonicalizeUserInfo {
my ($service, $key, $value) = @_;
commit fa595678ffd6f3953941531f23f448589355709f
Author: Mike Peachey <zordrak at cpan.org>
Date: Thu Nov 6 11:15:24 2008 +0000
* User_Vendor.pm reduced to absolute minimum
* Primary refactoring complete
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@16701 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/html/Callbacks/ExternalAuth/autohandler/Auth b/html/Callbacks/ExternalAuth/autohandler/Auth
index be79aa2..3430d84 100644
--- a/html/Callbacks/ExternalAuth/autohandler/Auth
+++ b/html/Callbacks/ExternalAuth/autohandler/Auth
@@ -1,5 +1,7 @@
<%init>
+use RT::Authen::ExternalAuth;
+
# If the RT::User::UpdateFromExternal method is not available, then we are in
# RT-3.8.0 or RT-3.8.1 and we need to work around a bug in the plugin system:
# Temporarily force RT to reload RT::User, since it isn't being loaded
@@ -37,22 +39,8 @@ unless ($session{'CurrentUser'}) {
# Unless we have loaded a valid user with a UserID
unless ($session{'CurrentUser'}->Id) {
# Check if user exists externally - autocreate user if it does
- my $user_exists_externally = 0;
- my @auth_services = @$RT::ExternalAuthPriority;
- foreach my $service (@auth_services) {
- my $config = $RT::Settings->{$service};
- if ($config->{'type'} eq 'db') {
- $user_exists_externally = RT::Authen::ExternalAuth::DBI->UserExists($service,$user);
- last if $user_exists_externally;
- } elsif ($config->{'type'} eq 'ldap') {
- $user_exists_externally = RT::Authen::ExternalAuth::LDAP->UserExists($service,$user);
- last if $user_exists_externally;
- } else {
- $RT::Logger->error("Invalid type specification in config for service:",$service);
- }
- }
-
- if($user_exists_externally){
+
+ if(RT::Authen::ExternalAuth->UserExists($user)){
my ($val, $msg) =
$UserObj->Create(%{ref($RT::AutoCreate) ? $RT::AutoCreate : {}},
Name => $user,
@@ -99,7 +87,7 @@ unless ($session{'CurrentUser'}) {
# the database, but more importantly, UpdateFromExternal will check
# whether the user is disabled or not which we have not been able to
# do during auto-create
- $session{'CurrentUser'}->UserObj->UpdateFromExternal();
+ RT::Authen::ExternalAuth->UpdateUserInfo($session{'CurrentUser'}->UserObj->Name);
# Now that we definitely have up-to-date user information,
# if the user is disabled, kick them out. Now!
diff --git a/lib/RT/Authen/ExternalAuth.pm b/lib/RT/Authen/ExternalAuth.pm
index b3c9ff9..ee77723 100644
--- a/lib/RT/Authen/ExternalAuth.pm
+++ b/lib/RT/Authen/ExternalAuth.pm
@@ -18,7 +18,323 @@ our $VERSION = '0.07_01';
=begin testing
ok(require RT::Authen::ExternalAuth);
+ok(require RT::Authen::ExternalAuth::LDAP);
+ok(require RT::Authen::ExternalAuth::DBI);
=end testing
+
+use RT::Authen::ExternalAuth::LDAP;
+use RT::Authen::ExternalAuth::DBI;
+sub UpdateUserInfo {
+ my $username = shift;
+
+ # Prepare for the worst...
+ my $found = 0;
+ my $updated = 0;
+ my $msg = "User NOT updated";
+
+ my $user_disabled = RT::Authen::ExternalAuth->UserDisabled($username);
+
+ my $UserObj = RT::User->new($RT::SystemUser);
+ $UserObj->Load($username);
+
+ # If user is disabled, set the RT::Principle to disabled and return out of the function.
+ # I think it's a waste of time and energy to update a user's information if they are disabled
+ # and it could be a security risk if they've updated their external information with some
+ # carefully concocted code to try to break RT - worst case scenario, but they have been
+ # denied access after all, don't take any chances.
+
+ # If someone gives me a good enough reason to do it,
+ # then I'll update all the info for disabled users
+
+ if ($user_disabled) {
+ # Make sure principle is disabled in RT
+ my ($val, $message) = $UserObj->SetDisabled(1);
+ # Log what has happened
+ $RT::Logger->info("User marked as DISABLED (",
+ $username,
+ ") per External Service",
+ "($val, $message)\n");
+ $msg = "User Disabled";
+
+ return ($updated, $msg);
+ }
+
+ # Make sure principle is not disabled in RT
+ my ($val, $message) = $UserObj->SetDisabled(0);
+ # Log what has happened
+ $RT::Logger->info("User marked as ENABLED (",
+ $username,
+ ") per External Service",
+ "($val, $message)\n");
+
+ # Update their info from external service using the username as the lookup key
+ # CanonicalizeUserInfo will work out for itself which service to use
+ # Passing it a service instead could break other RT code
+ my %args = (Name => $username);
+ $UserObj->CanonicalizeUserInfo(\%args);
+
+ # For each piece of information returned by CanonicalizeUserInfo,
+ # run the Set method for that piece of info to change it for the user
+ foreach my $key (sort(keys(%args))) {
+ next unless $args{$key};
+ my $method = "Set$key";
+ # We do this on the UserObj from above, not self so that there
+ # are no permission restrictions on setting information
+ my ($method_success,$method_msg) = $UserObj->$method($args{$key});
+
+ # If your user information is not getting updated,
+ # uncomment the following logging statements
+ if ($method_success) {
+ # At DEBUG level, log that method succeeded
+ # $RT::Logger->debug((caller(0))[3],"$method Succeeded. $method_msg");
+ } else {
+ # At DEBUG level, log that method failed
+ # $RT::Logger->debug((caller(0))[3],"$method Failed. $method_msg");
+ }
+ }
+
+ # Confirm update success
+ $updated = 1;
+ $RT::Logger->debug( "UPDATED user (",
+ $username,
+ ") from External Service\n");
+ $msg = 'User updated';
+
+ return ($updated, $msg);
+}
+
+sub UserExists {
+
+ my $username = shift;
+ my $user_exists_externally = 0;
+
+ my @auth_services = @$RT::ExternalAuthPriority;
+ foreach my $service (@auth_services) {
+ my $config = $RT::Settings->{$service};
+ if ($config->{'type'} eq 'db') {
+ $user_exists_externally = RT::Authen::ExternalAuth::DBI->UserExists($service,$user);
+ last if $user_exists_externally;
+ } elsif ($config->{'type'} eq 'ldap') {
+ $user_exists_externally = RT::Authen::ExternalAuth::LDAP->UserExists($service,$user);
+ last if $user_exists_externally;
+ } else {
+ $RT::Logger->error("Invalid type specification in config for service:",$service);
+ }
+ }
+
+ return $user_exists_externally;
+}
+
+sub GetAuth {
+
+ my ($username,$password) = @_;
+
+ # Get the prioritised list of external authentication services
+ my @auth_services = @$RT::ExternalAuthPriority;
+
+ # For each of those services..
+ foreach my $service (@auth_services) {
+
+ # Get the full configuration for that service as a hashref
+ my $config = $RT::ExternalSettings->{$service};
+ $RT::Logger->debug( "Attempting to use external auth service:",
+ $service);
+
+ # And then act accordingly depending on what type of service it is.
+ # Right now, there is only code for DBI and LDAP services
+ if ($config->{'type'} eq 'db') {
+ my $success = RT::Authen::ExternalAuth::DBI->GetAuth($service,$username,$password);
+ return 1 if $success;
+ next;
+
+ } elsif ($config->{'type'} eq 'ldap') {
+ my $success = RT::Authen::ExternalAuth::LDAP->GetAuth($service,$username,$password);
+ return 1 if $success;
+ next;
+
+ } else {
+ $RT::Logger->error("Invalid type specification in config for service:",
+ $service,
+ "- Skipping...");
+ }
+ }
+
+ # No success by now = failure.
+ return 0;
+
+}
+
+sub UserDisabled {
+
+ my $username = shift;
+ my $user_disabled = 0;
+
+ my @info_services = $RT::ExternalInfoPriority ? @{$RT::ExternalInfoPriority} : undef;
+
+ # For each named service in the list
+ # Check to see if the user is found in the external service
+ # If not found, jump to next service
+ # If found, check to see if user is considered disabled by the service
+ # Then update the user's info in RT and return
+ foreach my $service (@info_services) {
+
+ # Get the external config for this service as a hashref
+ my $config = $RT::ExternalSettings->{$service};
+
+ # If the config doesn't exist, don't bother doing anything, skip to next in list.
+ unless(defined($config)) {
+ $RT::Logger->debug("You haven't defined a configuration for the service named \"",
+ $service,
+ "\" so I'm not going to try to get user information from it. Skipping...");
+ next;
+ }
+
+ # If it's a DBI config:
+ if ($config->{'type'} eq 'db') {
+
+ unless(RT::Authen::ExternalAuth::DBI->UserExists($username,$service)) {
+ $RT::Logger->debug("User (",
+ $username,
+ ") doesn't exist in service (",
+ $service,
+ ") - Cannot update information - Skipping...");
+ next;
+ }
+ $user_disabled = RT::Authen::ExternalAuth::DBI->UserDisabled($username,$service);
+
+ } elsif ($config->{'type'} eq 'ldap') {
+
+ unless(RT::Authen::ExternalAuth::LDAP->UserExists($username,$service)) {
+ $RT::Logger->debug("User (",
+ $username,
+ ") doesn't exist in service (",
+ $service,
+ ") - Cannot update information - Skipping...");
+ next;
+ }
+ $user_disabled = RT::Authen::ExternalAuth::LDAP->UserDisabled($username,$service);
+
+ } else {
+ # The type of external service doesn't currently have any methods associated with it. Or it's a typo.
+ RT::Logger->error("Invalid type specification for config %config->{'name'}");
+ # Drop out to next service in list
+ next;
+ }
+
+ return $user_disabled;
+}
+
+sub CanonicalizeUserInfo {
+
+ # Careful, this $args hashref was given to RT::User::CanonicalizeUserInfo and
+ # then transparently passed on to this function. The whole purpose is to update
+ # the original hash as whatever passed it to RT::User is expecting to continue its
+ # code with an update args hash.
+
+ my $UserObj = shift;
+ my $args = shift;
+
+ my $found = 0;
+ my %params = (Name => undef,
+ EmailAddress => undef,
+ RealName => undef);
+
+ $RT::Logger->debug( (caller(0))[3],
+ "called by",
+ caller,
+ "with:",
+ join(", ", map {sprintf("%s: %s", $_, $args->{$_})}
+ sort(keys(%$args))));
+
+ # Get the list of defined external services
+ my @info_services = $RT::ExternalInfoPriority ? @{$RT::ExternalInfoPriority} : undef;
+ # For each external service...
+ foreach my $service (@info_services) {
+
+ $RT::Logger->debug( "Attempting to get user info using this external service:",
+ $service);
+
+ # Get the config for the service so that we know what attrs we can canonicalize
+ my $config = $RT::ExternalSettings->{$service};
+
+ # For each attr we've been told to canonicalize in the match list
+ foreach my $rt_attr (@{$config->{'attr_match_list'}}) {
+ # Jump to the next attr in $args if this one isn't in the attr_match_list
+ $RT::Logger->debug( "Attempting to use this canonicalization key:",$rt_attr);
+ unless(defined($args->{$rt_attr})) {
+ $RT::Logger->debug("This attribute (",
+ $rt_attr,
+ ") is not defined in the attr_match_list for this service (",
+ $service,
+ ")");
+ next;
+ }
+
+ # Else, use it as a canonicalization key and lookup the user info
+ my $key = $config->{'attr_map'}->{$rt_attr};
+ my $value = $args->{$rt_attr};
+
+ # Check to see that the key being asked for is defined in the config's attr_map
+ my $valid = 0;
+ my ($attr_key, $attr_value);
+ my $attr_map = $config->{'attr_map'};
+ while (($attr_key, $attr_value) = each %$attr_map) {
+ $valid = 1 if ($key eq $attr_value);
+ }
+ unless ($valid){
+ $RT::Logger->debug( "This key (",
+ $key,
+ "is not a valid attribute key (",
+ $service,
+ ")");
+ next;
+ }
+
+ # Use an if/elsif structure to do a lookup with any custom code needed
+ # for any given type of external service, or die if no code exists for
+ # the service requested.
+
+ if($config->{'type'} eq 'ldap'){
+ ($found, %params) = RT::Authen::ExternalAuth::LDAP->CanonicalizeUserInfo($service,$key,$value);
+ } elsif ($config->{'type'} eq 'db') {
+ ($found, %params) = RT::Authen::ExternalAuth::DBI->CanonicalizeUserInfo($service,$key,$value);
+ } else {
+ $RT::Logger->debug( (caller(0))[3],
+ "does not consider",
+ $service,
+ "a valid information service");
+ }
+
+ # Don't Check any more attributes
+ last if $found;
+ }
+ # Don't Check any more services
+ last if $found;
+ }
+
+ # If found, Canonicalize Email Address and
+ # update the args hash that we were given the hashref for
+ if ($found) {
+ # It's important that we always have a canonical email address
+ if ($params{'EmailAddress'}) {
+ $params{'EmailAddress'} = $self->CanonicalizeEmailAddress($params{'EmailAddress'});
+ }
+ %$args = (%$args, %params);
+ }
+
+ $RT::Logger->info( (caller(0))[3],
+ "returning",
+ join(", ", map {sprintf("%s: %s", $_, $args->{$_})}
+ sort(keys(%$args))));
+
+ ### HACK: The config var below is to overcome the (IMO) bug in
+ ### RT::User::Create() which expects this function to always
+ ### return true or rejects the user for creation. This should be
+ ### a different config var (CreateUncanonicalizedUsers) and
+ ### should be honored in RT::User::Create()
+ return($found || $RT::AutoCreateNonExternalUsers);
+
+}
1;
diff --git a/lib/RT/Authen/ExternalAuth/LDAP.pm b/lib/RT/Authen/ExternalAuth/LDAP.pm
index f715f65..de131a8 100644
--- a/lib/RT/Authen/ExternalAuth/LDAP.pm
+++ b/lib/RT/Authen/ExternalAuth/LDAP.pm
@@ -2,6 +2,7 @@ package RT::Authen::ExternalAuth::LDAP;
use Net::LDAP qw(LDAP_SUCCESS LDAP_PARTIAL_RESULTS);
use Net::LDAP::Util qw(ldap_error_name);
use Net::LDAP::Filter;
+require Net::SSLeay if $RT::ExternalServiceUsesSSLorTLS;
sub GetAuth {
diff --git a/lib/RT/User_Vendor.pm b/lib/RT/User_Vendor.pm
index 60818d7..2114fd5 100644
--- a/lib/RT/User_Vendor.pm
+++ b/lib/RT/User_Vendor.pm
@@ -7,64 +7,40 @@
no warnings qw(redefine);
use strict;
-use RT::Authen::ExternalAuth::LDAP;
-use RT::Authen::ExternalAuth::DBI;
+use RT::Authen::ExternalAuth;
-# We only need Net::SSLeay if one of our external services requires
-# OpenSSL because it plans to use SSL or TLS to encrypt connections
-require Net::SSLeay if $RT::ExternalServiceUsesSSLorTLS;
-
-sub IsExternalPassword {
- my $self = shift;
+# {{{ sub IsPassword
- my $name_to_auth = $self->Name;
- my $pass_to_auth = shift;
+sub IsPassword {
+ my $self = shift;
+ my $value = shift;
- $RT::Logger->debug( (caller(0))[3],
- "Trying External authentication");
-
- # Get the prioritised list of external authentication services
- my @auth_services = @$RT::ExternalAuthPriority;
-
- # For each of those services..
- foreach my $service (@auth_services) {
+ # TODO there isn't any apparent way to legitimately ACL this
- # Get the full configuration for that service as a hashref
- my $config = $RT::ExternalSettings->{$service};
- $RT::Logger->debug( "Attempting to use external auth service:",
- $service);
-
- # And then act accordingly depending on what type of service it is.
- # Right now, there is only code for DBI and LDAP services
- if ($config->{'type'} eq 'db') {
- my $success = RT::Authen::ExternalAuth::DBI->GetAuth($service,$name_to_auth,$pass_to_auth);
- return 1 if $success;
- next;
-
- } elsif ($config->{'type'} eq 'ldap') {
- my $success = RT::Authen::ExternalAuth::LDAP->GetAuth($service,$name_to_auth,$pass_to_auth);
- return 1 if $success;
- next;
-
- } else {
- $RT::Logger->error("Invalid type specification in config for service:",$service);
- }
- }
+ # RT does not allow null passwords
+ if ( ( !defined($value) ) or ( $value eq '' ) ) {
+ return (undef);
+ }
- # If we still haven't returned, we must have been unsuccessful
- $RT::Logger->info( (caller(0))[3],
- "External Auth Failed:",
- $name_to_auth);
- return 0;
-}
+ if ( $self->PrincipalObj && $self->PrincipalObj->Disabled ) {
+ $RT::Logger->info("Disabled user " . $self->Name .
+ " tried to log in" );
+ return (undef);
+ }
-sub IsInternalPassword {
- my $self = shift;
- my $value = shift;
+ if(RT::Authen::ExternalAuth->GetAuth($self->Name,$value)) {
+ $RT::Logger->debug( (caller(0))[3],
+ "EXTERNAL AUTH OKAY");
+ return(1);
+ } else {
+ $RT::Logger->debug( (caller(0))[3],
+ "EXTERNAL AUTH FAILED");
+ }
+
unless ($self->HasPassword) {
$RT::Logger->info( (caller(0))[3],
- "AUTH FAILED (no passwd):",
+ "INTERNAL AUTH FAILED (no passwd):",
$self->Name);
return(undef);
}
@@ -72,7 +48,7 @@ sub IsInternalPassword {
# generate an md5 password
if ($self->_GeneratePassword($value) eq $self->__Value('Password')) {
$RT::Logger->info( (caller(0))[3],
- "AUTH OKAY:",
+ "INTERNAL AUTH OKAY:",
$self->Name);
return(1);
}
@@ -84,52 +60,17 @@ sub IsInternalPassword {
# ...but upgrade the legacy password inplace.
$self->SUPER::SetPassword( $self->_GeneratePassword($value) );
$RT::Logger->info((caller(0))[3],
- "AUTH OKAY:",
+ "INTERNAL AUTH OKAY:",
$self->Name);
return(1);
}
$RT::Logger->info( (caller(0))[3],
- "AUTH FAILED:",
+ "INTERNAL AUTH FAILED:",
$self->Name);
- return(undef);
-}
-
-# {{{ sub IsPassword
-
-sub IsPassword {
- my $self = shift;
- my $value = shift;
-
- # TODO there isn't any apparent way to legitimately ACL this
-
- # RT does not allow null passwords
- if ( ( !defined($value) ) or ( $value eq '' ) ) {
- return (undef);
- }
-
- if ( $self->PrincipalObj && $self->PrincipalObj->Disabled ) {
- $RT::Logger->info("Disabled user " . $self->Name .
- " tried to log in" );
- return (undef);
- }
-
- my $success = undef;
-
- $success = $self->IsExternalPassword($value);
- $RT::Logger->debug( (caller(0))[3],
- "External auth",
- ($success ? 'SUCCEEDED' : 'FAILED'));
-
- unless ($success) {
- $success = $self->IsInternalPassword($value);
- $RT::Logger->debug( (caller(0))[3],
- "Internal auth",
- ($success ? 'SUCCEEDED' : 'FAILED'));
- }
- # We either got it or we didn't
- return ($success);
+ # If we haven't succeeded by now, fail.
+ return (undef);
}
# }}}
@@ -150,261 +91,10 @@ in all other cases.
sub CanonicalizeUserInfo {
my $self = shift;
my $args = shift;
-
- my $found = 0;
- my %params = (Name => undef,
- EmailAddress => undef,
- RealName => undef);
-
- $RT::Logger->debug( (caller(0))[3],
- "called by",
- caller,
- "with:",
- join(", ", map {sprintf("%s: %s", $_, $args->{$_})}
- sort(keys(%$args))));
-
- # Get the list of defined external services
- my @info_services = $RT::ExternalInfoPriority ? @{$RT::ExternalInfoPriority} : undef;
- # For each external service...
- foreach my $service (@info_services) {
-
- $RT::Logger->debug( "Attempting to get user info using this external service:",
- $service);
-
- # Get the config for the service so that we know what attrs we can canonicalize
- my $config = $RT::ExternalSettings->{$service};
-
- # For each attr we've been told to canonicalize in the match list
- foreach my $rt_attr (@{$config->{'attr_match_list'}}) {
- # Jump to the next attr in $args if this one isn't in the attr_match_list
- $RT::Logger->debug( "Attempting to use this canonicalization key:",$rt_attr);
- unless(defined($args->{$rt_attr})) {
- $RT::Logger->debug("This attribute (",
- $rt_attr,
- ") is not defined in the attr_match_list for this service (",
- $service,
- ")");
- next;
- }
-
- # Else, use it as a canonicalization key and lookup the user info
- my $key = $config->{'attr_map'}->{$rt_attr};
- my $value = $args->{$rt_attr};
-
- # Check to see that the key being asked for is defined in the config's attr_map
- my $valid = 0;
- my ($attr_key, $attr_value);
- my $attr_map = $config->{'attr_map'};
- while (($attr_key, $attr_value) = each %$attr_map) {
- $valid = 1 if ($key eq $attr_value);
- }
- unless ($valid){
- $RT::Logger->debug( "This key (",
- $key,
- "is not a valid attribute key (",
- $service,
- ")");
- next;
- }
-
- # Use an if/elsif structure to do a lookup with any custom code needed
- # for any given type of external service, or die if no code exists for
- # the service requested.
-
- if($config->{'type'} eq 'ldap'){
- ($found, %params) = RT::Authen::ExternalAuth::LDAP->CanonicalizeUserInfo($service,$key,$value);
- } elsif ($config->{'type'} eq 'db') {
- ($found, %params) = RT::Authen::ExternalAuth::DBI->CanonicalizeUserInfo($service,$key,$value);
- } else {
- $RT::Logger->debug( (caller(0))[3],
- "does not consider",
- $service,
- "a valid information service");
- }
-
- # Don't Check any more attributes
- last if $found;
- }
- # Don't Check any more services
- last if $found;
- }
-
- # If found, Canonicalize Email Address and
- # update the args hash that we were given the hashref for
- if ($found) {
- # It's important that we always have a canonical email address
- if ($params{'EmailAddress'}) {
- $params{'EmailAddress'} = $self->CanonicalizeEmailAddress($params{'EmailAddress'});
- }
- %$args = (%$args, %params);
- }
-
- $RT::Logger->info( (caller(0))[3],
- "returning",
- join(", ", map {sprintf("%s: %s", $_, $args->{$_})}
- sort(keys(%$args))));
-
- ### HACK: The config var below is to overcome the (IMO) bug in
- ### RT::User::Create() which expects this function to always
- ### return true or rejects the user for creation. This should be
- ### a different config var (CreateUncanonicalizedUsers) and
- ### should be honored in RT::User::Create()
- return($found || $RT::AutoCreateNonExternalUsers);
-
+ return($RT::Authen::ExternalAuth->CanonicalizeUserInfo($self,$args));
}
# }}}
-sub UpdateFromExternal {
- my $self = shift;
-
- # Prepare for the worst...
- my $found = 0;
- my $updated = 0;
- my $msg = "User NOT updated";
-
- my $username = $self->Name;
- my $user_disabled = 0;
-
- # Get the list of information service names requested by user.
- my @info_services = $RT::ExternalInfoPriority ? @{$RT::ExternalInfoPriority} : undef;
-
- # For each named service in the list
- # Check to see if the user is found in the external service
- # If not found, jump to next service
- # If found, check to see if user is considered disabled by the service
- # Then update the user's info in RT and return
- foreach my $service (@info_services) {
-
- # Get the external config for this service as a hashref
- my $config = $RT::ExternalSettings->{$service};
-
- # If the config doesn't exist, don't bother doing anything, skip to next in list.
- unless(defined($config)) {
- $RT::Logger->debug("You haven't defined a configuration for the service named \"",
- $service,
- "\" so I'm not going to try to get user information from it. Skipping...");
- next;
- }
-
- # If it's a DBI config:
- if ($config->{'type'} eq 'db') {
-
- unless(RT::Authen::ExternalAuth::DBI->UserExists($username,$service)) {
- $RT::Logger->debug("User (",
- $username,
- ") doesn't exist in service (",
- $service,
- ") - Cannot update information - Skipping...");
- next;
- }
- $user_disabled = RT::Authen::ExternalAuth::DBI->UserDisabled($username,$service);
-
- } elsif ($config->{'type'} eq 'ldap') {
-
- unless(RT::Authen::ExternalAuth::LDAP->UserExists($username,$service)) {
- $RT::Logger->debug("User (",
- $username,
- ") doesn't exist in service (",
- $service,
- ") - Cannot update information - Skipping...");
- next;
- }
- $user_disabled = RT::Authen::ExternalAuth::LDAP->UserDisabled($username,$service);
-
- } else {
- # The type of external service doesn't currently have any methods associated with it. Or it's a typo.
- RT::Logger->error("Invalid type specification for config %config->{'name'}");
- # Drop out to next service in list
- next;
- }
-
- # We are now going to update the user's information from the authoritative source
- # Although we are in a foreach, the statements below will only be executed once.
- # The external services have been checked in the priority order specified by the config.
- # If the user wasn't found in an individual service, we will already have jumped to the next one,
- # or we will have dropped out to the return statement at the base of the function if the user wasn't
- # found in ANY external services.
-
- # The user must have been found in a service to get here so we run the update code
- # and then "last" out of the foreach so that we only update from one source.
- # and then return out of the function
-
- # So, breathe, and on we go...
-
- # Load the user inside an RT::SystemUser so you can set their
- # information no matter who they are or what permissions they have
- my $UserObj = RT::User->new($RT::SystemUser);
- $UserObj->Load($username);
-
- # If user is disabled, set the RT::Principle to disabled and return out of the function.
- # I think it's a waste of time and energy to update a user's information if they are disabled
- # and it could be a security risk if they've updated their external information with some
- # carefully concocted code to try to break RT - worst case scenario, but they have been
- # denied access after all, don't take any chances.
-
- # If someone gives me a good enough reason to do it,
- # then I'll update all the info for disabled users
-
- if ($user_disabled) {
- # Make sure principle is disabled in RT
- my ($val, $message) = $UserObj->SetDisabled(1);
- # Log what has happened
- $RT::Logger->info("User marked as DISABLED (",
- $username,
- ") per External Service",
- "($val, $message)\n");
- $msg = "User disabled";
- } else {
- # Make sure principle is not disabled in RT
- my ($val, $message) = $UserObj->SetDisabled(0);
- # Log what has happened
- $RT::Logger->info("User marked as ENABLED (",
- $username,
- ") per External Service",
- "($val, $message)\n");
-
- # Update their info from external service using the username as the lookup key
- # CanonicalizeUserInfo will work out for itself which service to use
- # Passing it a service instead could break other RT code
- my %args = (Name => $username);
- $self->CanonicalizeUserInfo(\%args);
-
- # For each piece of information returned by CanonicalizeUserInfo,
- # run the Set method for that piece of info to change it for the user
- foreach my $key (sort(keys(%args))) {
- next unless $args{$key};
- my $method = "Set$key";
- # We do this on the UserObj from above, not self so that there
- # are no permission restrictions on setting information
- my ($method_success,$method_msg) = $UserObj->$method($args{$key});
-
- # If your user information is not getting updated,
- # uncomment the following logging statements
- if ($method_success) {
- # At DEBUG level, log that method succeeded
- # $RT::Logger->debug((caller(0))[3],"$method Succeeded. $method_msg");
- } else {
- # At DEBUG level, log that method failed
- # $RT::Logger->debug((caller(0))[3],"$method Failed. $method_msg");
- }
- }
-
- # Confirm update success
- $updated = 1;
- $RT::Logger->debug( "UPDATED user (",
- $username,
- ") from External Service\n");
- $msg = 'User updated';
-
- # Just in case we're not the last iteration of the foreach,
- # drop out to the return statement now.
- last;
-
- }
- }
-
- return ($updated, $msg);
-}
commit 983c1d2213a8973cc5e82621ccd6638606d3d39f
Author: Mike Peachey <zordrak at cpan.org>
Date: Thu Nov 6 11:46:37 2008 +0000
* 0.07_01-prealpha
* Perl reports all Syntax OK
* Going to set up a test rig to start testing the code's interaction with RT.
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@16702 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/html/Callbacks/ExternalAuth/autohandler/Auth b/html/Callbacks/ExternalAuth/autohandler/Auth
index 3430d84..3acf1df 100644
--- a/html/Callbacks/ExternalAuth/autohandler/Auth
+++ b/html/Callbacks/ExternalAuth/autohandler/Auth
@@ -2,15 +2,18 @@
use RT::Authen::ExternalAuth;
+# Since refactoring at 0.07_01 I believe the following workaround is now not required.
+######################################################################################
# If the RT::User::UpdateFromExternal method is not available, then we are in
# RT-3.8.0 or RT-3.8.1 and we need to work around a bug in the plugin system:
# Temporarily force RT to reload RT::User, since it isn't being loaded
# correctly as a plugin.
-unless (RT::User->can('UpdateFromExternal')) {
- $RT::Logger->error("Working around bug in RT and reloading RT::User");
- delete $INC{'RT/User.pm'};
- require RT::User;
-}
+#unless (RT::User->can('UpdateFromExternal')) {
+# $RT::Logger->error("Working around bug in RT and reloading RT::User");
+# delete $INC{'RT/User.pm'};
+# require RT::User;
+#}
+######################################################################################
# If the user is logging in, let's authenticate; if they can auth but don't load
# (e.g. they don't have an account but external auth succeeds), we'll autocreate
@@ -18,44 +21,35 @@ unless (RT::User->can('UpdateFromExternal')) {
unless ($session{'CurrentUser'}) {
# Password has not been confirmed valid until we say so
- my $password_validated;
-
- # This WAS used to stop a pointless LookupExternalUserInfo
- # called by UpdateFromExternal later on since it's already
- # called by RT::User::Create if the user is autocreated
- # but this has been deprecated pending a little bit of a
- # rewrite since I realised that we're not calling
- # CanonicalizeUserInfo but UpdateFromExternal which is the
- # only code that checks whether the user is externally
- # marked as disabled.
- my $user_autocreated = 0;
+ my $password_validated = 0;
# If $user has been passed by login page,
# or any other custom code previous to this
if (defined ($user)) {
$session{'CurrentUser'} = RT::CurrentUser->new();
+
+ # Does user exist internally?
$session{'CurrentUser'}->Load($user);
# Unless we have loaded a valid user with a UserID
unless ($session{'CurrentUser'}->Id) {
+
# Check if user exists externally - autocreate user if it does
-
if(RT::Authen::ExternalAuth->UserExists($user)){
- my ($val, $msg) =
- $UserObj->Create(%{ref($RT::AutoCreate) ? $RT::AutoCreate : {}},
- Name => $user,
- Gecos => $user,
- );
- unless ($val) {
- $RT::Logger->error( "Couldn't create user $user: $msg" );
- return;
- }
- $RT::Logger->info( "Autocreated authenticated user",
- $UserObj->Name,
- "(",
- $UserObj->Id,
- ")");
- $user_autocreated = 1;
+ my ($val, $msg) =
+ $UserObj->Create(%{ref($RT::AutoCreate) ? $RT::AutoCreate : {}},
+ Name => $user,
+ Gecos => $user,
+ );
+ unless ($val) {
+ $RT::Logger->error( "Couldn't create user $user: $msg" );
+ return;
+ }
+ $RT::Logger->info( "Autocreated authenticated user",
+ $UserObj->Name,
+ "(",
+ $UserObj->Id,
+ ")");
}
my ($val, $msg) = $UserObj->SetName($user);
diff --git a/lib/RT/User_Vendor.pm b/lib/RT/User_Vendor.pm
index 2114fd5..eb7ca1c 100644
--- a/lib/RT/User_Vendor.pm
+++ b/lib/RT/User_Vendor.pm
@@ -1,10 +1,3 @@
-### User_Vendor.pm
-# Overlay for RT::User object as part of RT::Authen::ExternalAuth
-#
-# Originally based on User_Local.pm for LDAP created by Jim Meyer (purp at acm.org) and found at:
-# http://wiki.bestpractical.com/view/LdapUserLocalOverlay
-
-
no warnings qw(redefine);
use strict;
use RT::Authen::ExternalAuth;
commit 44bc35d843339769f1983c69e87d49dfc1eca8cd
Author: Mike Peachey <zordrak at cpan.org>
Date: Thu Nov 6 13:06:59 2008 +0000
Critial RT::Authen::ExternalAuth fixes
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@16703 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/html/Callbacks/ExternalAuth/autohandler/Auth b/html/Callbacks/ExternalAuth/autohandler/Auth
index 3acf1df..30f0cae 100644
--- a/html/Callbacks/ExternalAuth/autohandler/Auth
+++ b/html/Callbacks/ExternalAuth/autohandler/Auth
@@ -34,9 +34,11 @@ unless ($session{'CurrentUser'}) {
# Unless we have loaded a valid user with a UserID
unless ($session{'CurrentUser'}->Id) {
+ my $UserObj = RT::User->new($RT::SystemUser);
+ my ($val, $ret, $msg);
# Check if user exists externally - autocreate user if it does
if(RT::Authen::ExternalAuth->UserExists($user)){
- my ($val, $msg) =
+ ($val, $msg) =
$UserObj->Create(%{ref($RT::AutoCreate) ? $RT::AutoCreate : {}},
Name => $user,
Gecos => $user,
@@ -50,22 +52,20 @@ unless ($session{'CurrentUser'}) {
"(",
$UserObj->Id,
")");
- }
- my ($val, $msg) = $UserObj->SetName($user);
+ ($val, $msg) = $UserObj->SetName($user);
- # If a password was given on the login page, validate it
- if (defined($pass)) {
- $password_validated = $UserObj->IsPassword($pass);
- }
+ # If a password was given on the login page, validate it
+ if (defined($pass)) {
+ $password_validated = $UserObj->IsPassword($pass);
+ }
- if($password_validated) {
- # If we autocreated a user, then load the user as the CurrentUser in $session
- # To RT, this means we have a valid, authenticated user
- if ($UserObj->Id) {
- my ($ret, $msg) = $session{'CurrentUser'}->Load($user);
- unless ($ret) {
- $RT::Logger->error("Couldn't load user $user: $msg");
+ if($password_validated) {
+ if ($UserObj->Id) {
+ ($ret, $msg) = $session{'CurrentUser'}->Load($user);
+ unless ($ret) {
+ $RT::Logger->error("Couldn't load user $user: $msg");
+ }
}
}
}
@@ -81,7 +81,7 @@ unless ($session{'CurrentUser'}) {
# the database, but more importantly, UpdateFromExternal will check
# whether the user is disabled or not which we have not been able to
# do during auto-create
- RT::Authen::ExternalAuth->UpdateUserInfo($session{'CurrentUser'}->UserObj->Name);
+ my ($updated,$update_msg) = RT::Authen::ExternalAuth->UpdateUserInfo($session{'CurrentUser'}->UserObj->Name);
# Now that we definitely have up-to-date user information,
# if the user is disabled, kick them out. Now!
commit f3e299741bed0a7df91862712418a4cc1f54112f
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Thu Nov 6 15:27:39 2008 +0000
* fix POD so functions get loaded.
* add missing }
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@16707 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/lib/RT/Authen/ExternalAuth.pm b/lib/RT/Authen/ExternalAuth.pm
index ee77723..edab67a 100644
--- a/lib/RT/Authen/ExternalAuth.pm
+++ b/lib/RT/Authen/ExternalAuth.pm
@@ -26,6 +26,8 @@ ok(require RT::Authen::ExternalAuth::DBI);
use RT::Authen::ExternalAuth::LDAP;
use RT::Authen::ExternalAuth::DBI;
+=cut
+
sub UpdateUserInfo {
my $username = shift;
@@ -223,6 +225,7 @@ sub UserDisabled {
next;
}
+ }
return $user_disabled;
}
commit aee27b7b95fdf79243f2c32f55306205f64c8606
Author: Mike Peachey <zordrak at cpan.org>
Date: Thu Nov 6 16:14:43 2008 +0000
RT::Authen::ExternalAuth -- committing to transfer
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@16708 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/html/Callbacks/ExternalAuth/autohandler/Auth b/html/Callbacks/ExternalAuth/autohandler/Auth
index 30f0cae..84e5069 100644
--- a/html/Callbacks/ExternalAuth/autohandler/Auth
+++ b/html/Callbacks/ExternalAuth/autohandler/Auth
@@ -37,7 +37,7 @@ unless ($session{'CurrentUser'}) {
my $UserObj = RT::User->new($RT::SystemUser);
my ($val, $ret, $msg);
# Check if user exists externally - autocreate user if it does
- if(RT::Authen::ExternalAuth->UserExists($user)){
+ if(RT::Authen::ExternalAuth::UserExists($user)){
($val, $msg) =
$UserObj->Create(%{ref($RT::AutoCreate) ? $RT::AutoCreate : {}},
Name => $user,
@@ -54,13 +54,15 @@ unless ($session{'CurrentUser'}) {
")");
($val, $msg) = $UserObj->SetName($user);
-
+ $RT::Logger->debug("Set Name result: Val:",$val,"Msg:",$msg);
# If a password was given on the login page, validate it
if (defined($pass)) {
+ $RT::Logger->debug("\$pass defined ($pass), Running IsPassword");
$password_validated = $UserObj->IsPassword($pass);
}
if($password_validated) {
+$RT::Logger->debug("Pass validated");
if ($UserObj->Id) {
($ret, $msg) = $session{'CurrentUser'}->Load($user);
unless ($ret) {
@@ -81,7 +83,7 @@ unless ($session{'CurrentUser'}) {
# the database, but more importantly, UpdateFromExternal will check
# whether the user is disabled or not which we have not been able to
# do during auto-create
- my ($updated,$update_msg) = RT::Authen::ExternalAuth->UpdateUserInfo($session{'CurrentUser'}->UserObj->Name);
+ my ($updated,$update_msg) = RT::Authen::ExternalAuth::UpdateUserInfo($session{'CurrentUser'}->UserObj->Name);
# Now that we definitely have up-to-date user information,
# if the user is disabled, kick them out. Now!
diff --git a/lib/RT/Authen/ExternalAuth.pm b/lib/RT/Authen/ExternalAuth.pm
index edab67a..f95e6f1 100644
--- a/lib/RT/Authen/ExternalAuth.pm
+++ b/lib/RT/Authen/ExternalAuth.pm
@@ -22,11 +22,12 @@ ok(require RT::Authen::ExternalAuth::LDAP);
ok(require RT::Authen::ExternalAuth::DBI);
=end testing
-
+
+=cut
+
use RT::Authen::ExternalAuth::LDAP;
use RT::Authen::ExternalAuth::DBI;
-
-=cut
+use Data::Dumper;
sub UpdateUserInfo {
my $username = shift;
@@ -109,20 +110,26 @@ sub UpdateUserInfo {
sub UserExists {
+ my $self = shift;
my $username = shift;
my $user_exists_externally = 0;
my @auth_services = @$RT::ExternalAuthPriority;
+$RT::Logger->debug("auth_services:",Dumper(@auth_services));
foreach my $service (@auth_services) {
- my $config = $RT::Settings->{$service};
+ my $config = $RT::ExternalSettings->{$service};
+$RT::Logger->debug("config:",Dumper($config));
if ($config->{'type'} eq 'db') {
- $user_exists_externally = RT::Authen::ExternalAuth::DBI->UserExists($service,$user);
+ $user_exists_externally = RT::Authen::ExternalAuth::DBI->UserExists($service,$username);
last if $user_exists_externally;
} elsif ($config->{'type'} eq 'ldap') {
- $user_exists_externally = RT::Authen::ExternalAuth::LDAP->UserExists($service,$user);
+ $user_exists_externally = RT::Authen::ExternalAuth::LDAP->UserExists($service,$username);
last if $user_exists_externally;
} else {
- $RT::Logger->error("Invalid type specification in config for service:",$service);
+ $RT::Logger->error("Invalid type specification (",
+ $config->{'type'},
+ ") in config for service:",
+ $service);
}
}
diff --git a/lib/RT/Authen/ExternalAuth/DBI.pm b/lib/RT/Authen/ExternalAuth/DBI.pm
index d263142..b0633f0 100644
--- a/lib/RT/Authen/ExternalAuth/DBI.pm
+++ b/lib/RT/Authen/ExternalAuth/DBI.pm
@@ -143,7 +143,7 @@ sub CanonicalizeUserInfo {
# Uncomment this to trace basic DBI throughput in a log
# DBI->trace(1,'/tmp/dbi.log');
- my $dbh = $self->_GetBoundDBIObj($config);
+ my $dbh = _GetBoundDBIObj($config);
my $results_hashref = $dbh->selectall_hashref($query,$key,{}, at bind_params);
$dbh->disconnect();
@@ -199,7 +199,7 @@ sub UserExists {
# DBI->trace(1,'/tmp/dbi.log');
# Get DBI Object, do the query, disconnect
- my $dbh = $self->_GetBoundDBIObj($config);
+ my $dbh = _GetBoundDBIObj($config);
my $results_hashref = $dbh->selectall_hashref($query,$u_field,{}, at bind_params);
$dbh->disconnect();
@@ -259,7 +259,7 @@ sub UserDisabled {
# DBI->trace(1,'/tmp/dbi.log');
# Get DBI Object, do the query, disconnect
- my $dbh = $self->_GetBoundDBIObj($config);
+ my $dbh = _GetBoundDBIObj($config);
my $results_hashref = $dbh->selectall_hashref($query,$u_field,{}, at bind_params);
$dbh->disconnect();
diff --git a/lib/RT/Authen/ExternalAuth/LDAP.pm b/lib/RT/Authen/ExternalAuth/LDAP.pm
index de131a8..ccfd25a 100644
--- a/lib/RT/Authen/ExternalAuth/LDAP.pm
+++ b/lib/RT/Authen/ExternalAuth/LDAP.pm
@@ -2,6 +2,7 @@ package RT::Authen::ExternalAuth::LDAP;
use Net::LDAP qw(LDAP_SUCCESS LDAP_PARTIAL_RESULTS);
use Net::LDAP::Util qw(ldap_error_name);
use Net::LDAP::Filter;
+use Data::Dumper;
require Net::SSLeay if $RT::ExternalServiceUsesSSLorTLS;
sub GetAuth {
@@ -181,7 +182,7 @@ sub CanonicalizeUserInfo {
}
# Get a Net::LDAP object based on the config we provide
- my $ldap = $self->_GetBoundLdapObj($config);
+ my $ldap = _GetBoundLdapObj($config);
# Jump to the next external information service if we can't get one,
# errors should be logged by _GetBoundLdapObj so we don't have to.
@@ -266,8 +267,8 @@ sub CanonicalizeUserInfo {
}
sub UserExists {
-
- my ($username,$service) = @_;
+ my ($self,$called_by,$service,$username) = @_;
+ $RT::Logger->debug("UserExists params:\nself: $self , called_by: $called_by , service: $service , username: $username");
my $config = $RT::ExternalSettings->{$service};
my $base = $config->{'base'};
@@ -291,7 +292,7 @@ sub UserExists {
);
}
- my $ldap = $self->_GetBoundLdapObj($config);
+ my $ldap = _GetBoundLdapObj($config);
next unless $ldap;
my @attrs = values(%{$config->{'attr_map'}});
@@ -384,7 +385,7 @@ sub UserDisabled {
}
- my $ldap = $self->_GetBoundLdapObj($config);
+ my $ldap = _GetBoundLdapObj($config);
next unless $ldap;
# We only need the UID for confirmation now,
commit c6e8dd7984fd5e8491f72803694e1b0614c4e43a
Author: Mike Peachey <zordrak at cpan.org>
Date: Thu Nov 6 16:24:20 2008 +0000
* 0.07_01-prealpha
* Major method calling issues sorted
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@16709 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/lib/RT/Authen/ExternalAuth.pm b/lib/RT/Authen/ExternalAuth.pm
index f95e6f1..73b37c2 100644
--- a/lib/RT/Authen/ExternalAuth.pm
+++ b/lib/RT/Authen/ExternalAuth.pm
@@ -37,7 +37,7 @@ sub UpdateUserInfo {
my $updated = 0;
my $msg = "User NOT updated";
- my $user_disabled = RT::Authen::ExternalAuth->UserDisabled($username);
+ my $user_disabled = RT::Authen::ExternalAuth::UserDisabled($username);
my $UserObj = RT::User->new($RT::SystemUser);
$UserObj->Load($username);
@@ -110,20 +110,19 @@ sub UpdateUserInfo {
sub UserExists {
- my $self = shift;
my $username = shift;
my $user_exists_externally = 0;
my @auth_services = @$RT::ExternalAuthPriority;
-$RT::Logger->debug("auth_services:",Dumper(@auth_services));
+
foreach my $service (@auth_services) {
my $config = $RT::ExternalSettings->{$service};
-$RT::Logger->debug("config:",Dumper($config));
+
if ($config->{'type'} eq 'db') {
- $user_exists_externally = RT::Authen::ExternalAuth::DBI->UserExists($service,$username);
+ $user_exists_externally = RT::Authen::ExternalAuth::DBI::UserExists($service,$username);
last if $user_exists_externally;
} elsif ($config->{'type'} eq 'ldap') {
- $user_exists_externally = RT::Authen::ExternalAuth::LDAP->UserExists($service,$username);
+ $user_exists_externally = RT::Authen::ExternalAuth::LDAP::UserExists($service,$username);
last if $user_exists_externally;
} else {
$RT::Logger->error("Invalid type specification (",
@@ -154,12 +153,12 @@ sub GetAuth {
# And then act accordingly depending on what type of service it is.
# Right now, there is only code for DBI and LDAP services
if ($config->{'type'} eq 'db') {
- my $success = RT::Authen::ExternalAuth::DBI->GetAuth($service,$username,$password);
+ my $success = RT::Authen::ExternalAuth::DBI::GetAuth($service,$username,$password);
return 1 if $success;
next;
} elsif ($config->{'type'} eq 'ldap') {
- my $success = RT::Authen::ExternalAuth::LDAP->GetAuth($service,$username,$password);
+ my $success = RT::Authen::ExternalAuth::LDAP::GetAuth($service,$username,$password);
return 1 if $success;
next;
@@ -203,7 +202,7 @@ sub UserDisabled {
# If it's a DBI config:
if ($config->{'type'} eq 'db') {
- unless(RT::Authen::ExternalAuth::DBI->UserExists($username,$service)) {
+ unless(RT::Authen::ExternalAuth::DBI::UserExists($username,$service)) {
$RT::Logger->debug("User (",
$username,
") doesn't exist in service (",
@@ -211,11 +210,11 @@ sub UserDisabled {
") - Cannot update information - Skipping...");
next;
}
- $user_disabled = RT::Authen::ExternalAuth::DBI->UserDisabled($username,$service);
+ $user_disabled = RT::Authen::ExternalAuth::DBI::UserDisabled($username,$service);
} elsif ($config->{'type'} eq 'ldap') {
- unless(RT::Authen::ExternalAuth::LDAP->UserExists($username,$service)) {
+ unless(RT::Authen::ExternalAuth::LDAP::UserExists($username,$service)) {
$RT::Logger->debug("User (",
$username,
") doesn't exist in service (",
@@ -223,7 +222,7 @@ sub UserDisabled {
") - Cannot update information - Skipping...");
next;
}
- $user_disabled = RT::Authen::ExternalAuth::LDAP->UserDisabled($username,$service);
+ $user_disabled = RT::Authen::ExternalAuth::LDAP::UserDisabled($username,$service);
} else {
# The type of external service doesn't currently have any methods associated with it. Or it's a typo.
@@ -307,9 +306,9 @@ sub CanonicalizeUserInfo {
# the service requested.
if($config->{'type'} eq 'ldap'){
- ($found, %params) = RT::Authen::ExternalAuth::LDAP->CanonicalizeUserInfo($service,$key,$value);
+ ($found, %params) = RT::Authen::ExternalAuth::LDAP::CanonicalizeUserInfo($service,$key,$value);
} elsif ($config->{'type'} eq 'db') {
- ($found, %params) = RT::Authen::ExternalAuth::DBI->CanonicalizeUserInfo($service,$key,$value);
+ ($found, %params) = RT::Authen::ExternalAuth::DBI::CanonicalizeUserInfo($service,$key,$value);
} else {
$RT::Logger->debug( (caller(0))[3],
"does not consider",
diff --git a/lib/RT/Authen/ExternalAuth/LDAP.pm b/lib/RT/Authen/ExternalAuth/LDAP.pm
index ccfd25a..04b27d5 100644
--- a/lib/RT/Authen/ExternalAuth/LDAP.pm
+++ b/lib/RT/Authen/ExternalAuth/LDAP.pm
@@ -62,7 +62,7 @@ sub GetAuth {
unless ($ldap_msg->count == 1) {
$RT::Logger->info( $service,
"AUTH FAILED:",
- $self->Name,
+ $username,
"User not found or more than one user found");
# We got no user, or too many users.. jump straight to the next external auth service
return 0;
diff --git a/lib/RT/User_Vendor.pm b/lib/RT/User_Vendor.pm
index eb7ca1c..c474af0 100644
--- a/lib/RT/User_Vendor.pm
+++ b/lib/RT/User_Vendor.pm
@@ -22,7 +22,7 @@ sub IsPassword {
}
- if(RT::Authen::ExternalAuth->GetAuth($self->Name,$value)) {
+ if(RT::Authen::ExternalAuth::GetAuth($self->Name,$value)) {
$RT::Logger->debug( (caller(0))[3],
"EXTERNAL AUTH OKAY");
return(1);
@@ -84,7 +84,7 @@ in all other cases.
sub CanonicalizeUserInfo {
my $self = shift;
my $args = shift;
- return($RT::Authen::ExternalAuth->CanonicalizeUserInfo($self,$args));
+ return($RT::Authen::ExternalAuth::CanonicalizeUserInfo($self,$args));
}
# }}}
commit 0717f09766e69f6fa1045081a66e243f1434133d
Author: Mike Peachey <zordrak at cpan.org>
Date: Thu Nov 6 17:03:02 2008 +0000
RT::Authen::ExternalAuth v0.07_01-prealpha : First functional commit
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@16715 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/html/Callbacks/ExternalAuth/autohandler/Auth b/html/Callbacks/ExternalAuth/autohandler/Auth
index 84e5069..81568e5 100644
--- a/html/Callbacks/ExternalAuth/autohandler/Auth
+++ b/html/Callbacks/ExternalAuth/autohandler/Auth
@@ -2,16 +2,14 @@
use RT::Authen::ExternalAuth;
-# Since refactoring at 0.07_01 I believe the following workaround is now not required.
-######################################################################################
# If the RT::User::UpdateFromExternal method is not available, then we are in
# RT-3.8.0 or RT-3.8.1 and we need to work around a bug in the plugin system:
# Temporarily force RT to reload RT::User, since it isn't being loaded
# correctly as a plugin.
#unless (RT::User->can('UpdateFromExternal')) {
-# $RT::Logger->error("Working around bug in RT and reloading RT::User");
-# delete $INC{'RT/User.pm'};
-# require RT::User;
+ $RT::Logger->error("Working around bug in RT and reloading RT::User");
+ delete $INC{'RT/User.pm'};
+ require RT::User;
#}
######################################################################################
@@ -32,14 +30,14 @@ unless ($session{'CurrentUser'}) {
$session{'CurrentUser'}->Load($user);
# Unless we have loaded a valid user with a UserID
+ # check if user exists externally and autocreate if it does
unless ($session{'CurrentUser'}->Id) {
- my $UserObj = RT::User->new($RT::SystemUser);
+ $session{'CurrentUser'} = RT::User->new($RT::SystemUser);
my ($val, $ret, $msg);
- # Check if user exists externally - autocreate user if it does
if(RT::Authen::ExternalAuth::UserExists($user)){
($val, $msg) =
- $UserObj->Create(%{ref($RT::AutoCreate) ? $RT::AutoCreate : {}},
+ $session{'CurrentUser'}->Create(%{ref($RT::AutoCreate) ? $RT::AutoCreate : {}},
Name => $user,
Gecos => $user,
);
@@ -48,29 +46,25 @@ unless ($session{'CurrentUser'}) {
return;
}
$RT::Logger->info( "Autocreated authenticated user",
- $UserObj->Name,
+ $session{'CurrentUser'}->Name,
"(",
- $UserObj->Id,
+ $session{'CurrentUser'}->Id,
")");
- ($val, $msg) = $UserObj->SetName($user);
+ ($val, $msg) = $session{'CurrentUser'}->SetName($user);
$RT::Logger->debug("Set Name result: Val:",$val,"Msg:",$msg);
- # If a password was given on the login page, validate it
- if (defined($pass)) {
- $RT::Logger->debug("\$pass defined ($pass), Running IsPassword");
- $password_validated = $UserObj->IsPassword($pass);
- }
-
- if($password_validated) {
-$RT::Logger->debug("Pass validated");
- if ($UserObj->Id) {
- ($ret, $msg) = $session{'CurrentUser'}->Load($user);
- unless ($ret) {
- $RT::Logger->error("Couldn't load user $user: $msg");
- }
- }
- }
}
+ }
+
+ # If a password was given on the login page, validate it
+ if (defined($pass)) {
+ $RT::Logger->debug("\$pass defined ($pass), Running IsPassword");
+ $password_validated = $session{'CurrentUser'}->IsPassword($pass);
+ }
+
+ unless($password_validated) {
+ $RT::Logger->debug("Password Incorrect");
+ delete $session{'CurrentUser'};
}
}
diff --git a/lib/RT/Authen/ExternalAuth.pm b/lib/RT/Authen/ExternalAuth.pm
index 73b37c2..1ad4d65 100644
--- a/lib/RT/Authen/ExternalAuth.pm
+++ b/lib/RT/Authen/ExternalAuth.pm
@@ -328,7 +328,7 @@ sub CanonicalizeUserInfo {
if ($found) {
# It's important that we always have a canonical email address
if ($params{'EmailAddress'}) {
- $params{'EmailAddress'} = $self->CanonicalizeEmailAddress($params{'EmailAddress'});
+ $params{'EmailAddress'} = $UserObj->CanonicalizeEmailAddress($params{'EmailAddress'});
}
%$args = (%$args, %params);
}
diff --git a/lib/RT/Authen/ExternalAuth/LDAP.pm b/lib/RT/Authen/ExternalAuth/LDAP.pm
index 04b27d5..0249886 100644
--- a/lib/RT/Authen/ExternalAuth/LDAP.pm
+++ b/lib/RT/Authen/ExternalAuth/LDAP.pm
@@ -31,7 +31,7 @@ sub GetAuth {
$filter = Net::LDAP::Filter->new( '(&(' .
$attr_map->{'Name'} .
'=' .
- $self->Name .
+ $username .
')' .
$filter .
')'
@@ -73,12 +73,12 @@ sub GetAuth {
$ldap_dn);
# THIS bind determines success or failure on the password.
- $ldap_msg = $ldap->bind($ldap_dn, password => $pass_to_auth);
+ $ldap_msg = $ldap->bind($ldap_dn, password => $password);
unless ($ldap_msg->code == LDAP_SUCCESS) {
$RT::Logger->info( $service,
"AUTH FAILED",
- $self->Name,
+ $username,
"(can't bind:",
ldap_error_name($ldap_msg->code),
$ldap_msg->code,
@@ -123,7 +123,7 @@ sub GetAuth {
unless ($ldap_msg->count == 1) {
$RT::Logger->info( $service,
"AUTH FAILED:",
- $self->Name);
+ $username);
# Fail auth - jump to next external auth service
return 0;
@@ -267,8 +267,8 @@ sub CanonicalizeUserInfo {
}
sub UserExists {
- my ($self,$called_by,$service,$username) = @_;
- $RT::Logger->debug("UserExists params:\nself: $self , called_by: $called_by , service: $service , username: $username");
+ my ($username,$service) = @_;
+ $RT::Logger->debug("UserExists params:\nusername: $username , service: $service");
my $config = $RT::ExternalSettings->{$service};
my $base = $config->{'base'};
diff --git a/lib/RT/User_Vendor.pm b/lib/RT/User_Vendor.pm
index c474af0..dbb1006 100644
--- a/lib/RT/User_Vendor.pm
+++ b/lib/RT/User_Vendor.pm
@@ -21,7 +21,7 @@ sub IsPassword {
return (undef);
}
-
+ $RT::Logger->debug("Trying External Authentication (",$self->Name,")");
if(RT::Authen::ExternalAuth::GetAuth($self->Name,$value)) {
$RT::Logger->debug( (caller(0))[3],
"EXTERNAL AUTH OKAY");
@@ -84,7 +84,7 @@ in all other cases.
sub CanonicalizeUserInfo {
my $self = shift;
my $args = shift;
- return($RT::Authen::ExternalAuth::CanonicalizeUserInfo($self,$args));
+ return(RT::Authen::ExternalAuth::CanonicalizeUserInfo($self,$args));
}
# }}}
commit 0160304fe8e35afe46125a2abb5b70070d4da964
Author: Mike Peachey <zordrak at cpan.org>
Date: Thu Nov 6 17:11:08 2008 +0000
RT::Authen::ExternalAuth v0.07_01-prealpha : Principal problems
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@16718 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/html/Callbacks/ExternalAuth/autohandler/Auth b/html/Callbacks/ExternalAuth/autohandler/Auth
index 81568e5..fb8be82 100644
--- a/html/Callbacks/ExternalAuth/autohandler/Auth
+++ b/html/Callbacks/ExternalAuth/autohandler/Auth
@@ -77,7 +77,7 @@ unless ($session{'CurrentUser'}) {
# the database, but more importantly, UpdateFromExternal will check
# whether the user is disabled or not which we have not been able to
# do during auto-create
- my ($updated,$update_msg) = RT::Authen::ExternalAuth::UpdateUserInfo($session{'CurrentUser'}->UserObj->Name);
+ my ($updated,$update_msg) = RT::Authen::ExternalAuth::UpdateUserInfo($session{'CurrentUser'}->Name);
# Now that we definitely have up-to-date user information,
# if the user is disabled, kick them out. Now!
diff --git a/lib/RT/Authen/ExternalAuth.pm b/lib/RT/Authen/ExternalAuth.pm
index 1ad4d65..f43633e 100644
--- a/lib/RT/Authen/ExternalAuth.pm
+++ b/lib/RT/Authen/ExternalAuth.pm
@@ -119,10 +119,10 @@ sub UserExists {
my $config = $RT::ExternalSettings->{$service};
if ($config->{'type'} eq 'db') {
- $user_exists_externally = RT::Authen::ExternalAuth::DBI::UserExists($service,$username);
+ $user_exists_externally = RT::Authen::ExternalAuth::DBI::UserExists($username,$service);
last if $user_exists_externally;
} elsif ($config->{'type'} eq 'ldap') {
- $user_exists_externally = RT::Authen::ExternalAuth::LDAP::UserExists($service,$username);
+ $user_exists_externally = RT::Authen::ExternalAuth::LDAP::UserExists($username,$service);
last if $user_exists_externally;
} else {
$RT::Logger->error("Invalid type specification (",
commit 8fe34981bc4ab095d83bd1b7e012e3d3562ee9f4
Author: Mike Peachey <zordrak at cpan.org>
Date: Thu Nov 6 18:21:05 2008 +0000
RT::Authen::ExternalAuth
* Attempted fix for Auth and autocreate issues
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@16724 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/html/Callbacks/ExternalAuth/autohandler/Auth b/html/Callbacks/ExternalAuth/autohandler/Auth
index fb8be82..c953d70 100644
--- a/html/Callbacks/ExternalAuth/autohandler/Auth
+++ b/html/Callbacks/ExternalAuth/autohandler/Auth
@@ -32,12 +32,10 @@ unless ($session{'CurrentUser'}) {
# Unless we have loaded a valid user with a UserID
# check if user exists externally and autocreate if it does
unless ($session{'CurrentUser'}->Id) {
-
- $session{'CurrentUser'} = RT::User->new($RT::SystemUser);
- my ($val, $ret, $msg);
if(RT::Authen::ExternalAuth::UserExists($user)){
- ($val, $msg) =
- $session{'CurrentUser'}->Create(%{ref($RT::AutoCreate) ? $RT::AutoCreate : {}},
+ my $UserObj = RT::User->new($RT::SystemUser);
+ my ($val, $msg) =
+ $UserObj->Create(%{ref($RT::AutoCreate) ? $RT::AutoCreate : {}},
Name => $user,
Gecos => $user,
);
@@ -45,31 +43,38 @@ unless ($session{'CurrentUser'}) {
$RT::Logger->error( "Couldn't create user $user: $msg" );
return;
}
- $RT::Logger->info( "Autocreated authenticated user",
- $session{'CurrentUser'}->Name,
+ $RT::Logger->info( "Autocreated external user",
+ $UserObj->Name,
"(",
- $session{'CurrentUser'}->Id,
+ $UserObj->Id,
")");
-
- ($val, $msg) = $session{'CurrentUser'}->SetName($user);
- $RT::Logger->debug("Set Name result: Val:",$val,"Msg:",$msg);
+
+ $RT::Logger->debug("Loading new user (",
+ $user,
+ ") into current session");
+ $session{'CurrentUser'}->Load($user);
}
}
-
- # If a password was given on the login page, validate it
- if (defined($pass)) {
- $RT::Logger->debug("\$pass defined ($pass), Running IsPassword");
- $password_validated = $session{'CurrentUser'}->IsPassword($pass);
- }
-
- unless($password_validated) {
- $RT::Logger->debug("Password Incorrect");
- delete $session{'CurrentUser'};
- }
}
# If we now have a completely valid RT user to play with...
if ($session{'CurrentUser'} && $session{'CurrentUser'}->Id) {
+
+ # If a password was given on the login page, validate it
+ if (defined($pass)) {
+ $RT::Logger->debug("\$pass defined ($pass), Running IsPassword");
+ $password_validated = $session{'CurrentUser'}->UserObj->IsPassword($pass);
+ }
+
+ unless($password_validated) {
+ $RT::Logger->debug("Password Incorrect");
+ delete $session{'CurrentUser'};
+ }
+ }
+
+ # If we STILL have a completely valid RT user to play with...
+ # and therefore password has been validated...
+ if ($session{'CurrentUser'} && $session{'CurrentUser'}->Id) {
# Even if we have JUST created the user in RT, we are going to
# reload their information from an external source. This allows us
@@ -95,8 +100,9 @@ unless ($session{'CurrentUser'}) {
# done by the autohandler this Callback is extending if
# we delete the session.
- # If we have a full user and the session hasn't already been deleted
+ # If we **STILL** have a full user and the session hasn't already been deleted
if ($session{'CurrentUser'} && $session{'CurrentUser'}->Id) {
+ # Sanity check
if($password_validated) {
$RT::Logger->info( "Successful login for",
commit e2ee1a64e6bdf1014ddd11726092c0f965c927a2
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Thu Nov 6 18:24:56 2008 +0000
* we're in a subroutine, not a loop so return
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@16725 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/lib/RT/Authen/ExternalAuth/LDAP.pm b/lib/RT/Authen/ExternalAuth/LDAP.pm
index 0249886..0ebe03a 100644
--- a/lib/RT/Authen/ExternalAuth/LDAP.pm
+++ b/lib/RT/Authen/ExternalAuth/LDAP.pm
@@ -293,7 +293,7 @@ sub UserExists {
}
my $ldap = _GetBoundLdapObj($config);
- next unless $ldap;
+ return unless $ldap;
my @attrs = values(%{$config->{'attr_map'}});
commit 38ab2fecb5047925b272b596f8f7cac5e82a1bd6
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Thu Nov 6 20:41:00 2008 +0000
* only load once
* force User_Overlay to reload also
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@16732 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/html/Callbacks/ExternalAuth/autohandler/Auth b/html/Callbacks/ExternalAuth/autohandler/Auth
index c953d70..0a055cd 100644
--- a/html/Callbacks/ExternalAuth/autohandler/Auth
+++ b/html/Callbacks/ExternalAuth/autohandler/Auth
@@ -1,16 +1,20 @@
+<%once>
+my $loaded_user = 0;
+</%once>
<%init>
use RT::Authen::ExternalAuth;
-# If the RT::User::UpdateFromExternal method is not available, then we are in
-# RT-3.8.0 or RT-3.8.1 and we need to work around a bug in the plugin system:
+# Work around a bug in the RT 3.8.0 and 3.8.1 plugin system (fixed in 3.8.2)
# Temporarily force RT to reload RT::User, since it isn't being loaded
# correctly as a plugin.
-#unless (RT::User->can('UpdateFromExternal')) {
+unless ($loaded_user) {
$RT::Logger->error("Working around bug in RT and reloading RT::User");
+ $loaded_user++;
delete $INC{'RT/User.pm'};
+ delete $INC{'RT/User_Overlay.pm'};
require RT::User;
-#}
+}
######################################################################################
# If the user is logging in, let's authenticate; if they can auth but don't load
commit da310540ce1a605c6095ae802f29735d8f258cf4
Author: Mike Peachey <zordrak at cpan.org>
Date: Fri Nov 7 18:04:07 2008 +0000
* 0.07_01
* Added fix for Novell eDirectory from John McCoy
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@16740 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/lib/RT/Authen/ExternalAuth/LDAP.pm b/lib/RT/Authen/ExternalAuth/LDAP.pm
index 0ebe03a..1d0d2ef 100644
--- a/lib/RT/Authen/ExternalAuth/LDAP.pm
+++ b/lib/RT/Authen/ExternalAuth/LDAP.pm
@@ -452,10 +452,10 @@ sub _GetBoundLdapObj {
my $msg = undef;
- # Can't decide whether to add a little more error checking here..
- # Perhaps, if user && pass, else dont pass a pass etc..
- if ($ldap_user) {
+ if (($ldap_user) and ($ldap_pass)) {
$msg = $ldap->bind($ldap_user, password => $ldap_pass);
+ } elsif (($ldap_user) and ( ! $ldap_pass)) {
+ $msg = $ldap->bind($ldap_user);
} else {
$msg = $ldap->bind;
}
commit a4909f8ddac99affc3021b4c257ec839b6c1d45d
Author: Mike Peachey <zordrak at cpan.org>
Date: Mon Nov 10 15:13:49 2008 +0000
* 0.07_01
* LDAP.pm line 140 - $name_to_auth needed renaming to $username during refactoring but was missed.
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@16807 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/lib/RT/Authen/ExternalAuth/LDAP.pm b/lib/RT/Authen/ExternalAuth/LDAP.pm
index 1d0d2ef..53ee46e 100644
--- a/lib/RT/Authen/ExternalAuth/LDAP.pm
+++ b/lib/RT/Authen/ExternalAuth/LDAP.pm
@@ -137,7 +137,7 @@ sub GetAuth {
"External Auth OK (",
$service,
"):",
- $name_to_auth);
+ $username);
return 1;
}
commit bd445bd2fae1848b19f7cab2765f109cbe0b59b9
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Mon Dec 22 16:47:21 2008 +0000
* 3.8.2 correctly loads User, so we need to reload
Vendor also to avoid losing ExternalAuth's code.
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@17292 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/html/Callbacks/ExternalAuth/autohandler/Auth b/html/Callbacks/ExternalAuth/autohandler/Auth
index 0a055cd..0af6f8e 100644
--- a/html/Callbacks/ExternalAuth/autohandler/Auth
+++ b/html/Callbacks/ExternalAuth/autohandler/Auth
@@ -13,6 +13,7 @@ unless ($loaded_user) {
$loaded_user++;
delete $INC{'RT/User.pm'};
delete $INC{'RT/User_Overlay.pm'};
+ delete $INC{'RT/User_Vendor.pm'};
require RT::User;
}
######################################################################################
commit 565064606a9299b3c502be4e646c40480d9e3695
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Mon Dec 22 22:06:32 2008 +0000
new release to play well with 3.8.2
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@17294 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/ChangeLog b/ChangeLog
index 2b9d362..ec4513b 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+v0.07_02 2008-12-22 Mon 17:01 -0500
+
+ * html/Callbacks/ExternalAuth/autohandler/Auth
+
+ Make the workaround needed for 3.8.1 work
+ on 3.8.2
+
v0.06 2008-11-01 Mike Peachey <zordrak at cpan.org>
* README
diff --git a/META.yml b/META.yml
index dd317fc..f5e16ed 100644
--- a/META.yml
+++ b/META.yml
@@ -17,6 +17,5 @@ no_index:
- var
- inc
requires:
- Net::LDAP: 0
RT: 0
-version: 0.06_02
+version: 0.07_02
diff --git a/lib/RT/Authen/ExternalAuth.pm b/lib/RT/Authen/ExternalAuth.pm
index f43633e..38f8887 100644
--- a/lib/RT/Authen/ExternalAuth.pm
+++ b/lib/RT/Authen/ExternalAuth.pm
@@ -1,6 +1,6 @@
package RT::Authen::ExternalAuth;
-our $VERSION = '0.07_01';
+our $VERSION = '0.07_02';
=head1 NAME
commit c7e24ced29127a22d8d850a0813af100d30618b5
Author: Mike Peachey <zordrak at cpan.org>
Date: Fri Jan 16 10:47:52 2009 +0000
RT::Authen::ExternalAuth -- Start of 0.07_03
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@17771 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/ChangeLog b/ChangeLog
index ec4513b..1f8e22d 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,9 +1,26 @@
-v0.07_02 2008-12-22 Mon 17:01 -0500
+v0.07_03 2009-01-16 Mike Peachey <zordrak at cpan.org>
+
+ * ChangeLog
+
+ Added entry for v0.07_01
+
+ * lib/RT/Authen/ExternalAuth.pm
+
+ Version updated to 0.07_03
- * html/Callbacks/ExternalAuth/autohandler/Auth
+v0.07_02 2008-12-22 Kevin Falcone <falcone at cpan.org>
+
+ * html/Callbacks/ExternalAuth/autohandler/Auth
- Make the workaround needed for 3.8.1 work
- on 3.8.2
+ Make the workaround needed for 3.8.1 work on 3.8.2
+
+v0.07_01 2008-11-06 Mike Peachey <zordrak at cpan.org>
+ Kevin Falcone <falcone at cpan.org>
+
+ * ALL
+
+ Complete code refactoring and updates for RT-3.8.x
+ compatability.
v0.06 2008-11-01 Mike Peachey <zordrak at cpan.org>
diff --git a/lib/RT/Authen/ExternalAuth.pm b/lib/RT/Authen/ExternalAuth.pm
index 38f8887..5a25ac1 100644
--- a/lib/RT/Authen/ExternalAuth.pm
+++ b/lib/RT/Authen/ExternalAuth.pm
@@ -1,6 +1,6 @@
package RT::Authen::ExternalAuth;
-our $VERSION = '0.07_02';
+our $VERSION = '0.07_03';
=head1 NAME
commit 00445a586404a6ec9b2c3e6742db9867152f7ae6
Author: Mike Peachey <zordrak at cpan.org>
Date: Fri Jan 16 12:18:56 2009 +0000
RT::Authen::ExternalAuth // 2009-01-16 Zordrak <zordrak at cpan.org> // CookieAuth pulled in as subpackage of DBI
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@17776 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/html/Callbacks/ExternalAuth/autohandler/Auth b/html/Callbacks/ExternalAuth/autohandler/Auth
index 0af6f8e..e97dc99 100644
--- a/html/Callbacks/ExternalAuth/autohandler/Auth
+++ b/html/Callbacks/ExternalAuth/autohandler/Auth
@@ -4,7 +4,7 @@ my $loaded_user = 0;
<%init>
use RT::Authen::ExternalAuth;
-
+######################################################################################
# Work around a bug in the RT 3.8.0 and 3.8.1 plugin system (fixed in 3.8.2)
# Temporarily force RT to reload RT::User, since it isn't being loaded
# correctly as a plugin.
@@ -18,6 +18,120 @@ unless ($loaded_user) {
}
######################################################################################
+
+
+##########################################################
+##################### CA #################################
+##########################################################
+#
+# If the user is logging in, let's authenticate; if they can auth but don't load
+# (e.g. they don't have an account but external auth succeeds), we'll autocreate
+# their account.
+unless ($session{'CurrentUser'}) {
+
+ # Check to see if we've been asked to authenticate from cookies
+ # If so, confirm the username authenticated by the cookies
+ if ($RT::UseExternalCookieAuthService){
+ $RT::Logger->debug( "Cookie Authentication (",
+ $RT::UseExternalCookieAuthService,
+ ") requested");
+
+ # Use the package we need for cookie authentication
+
+ my ($cookie_user, $confirmed_by_cookie) = RT::Authen::ExternalAuth::CheckCookies();
+
+ # If CheckCookies gave us a user, set it as the global user.
+ $user = $cookie_user if defined($cookie_user);
+
+ # If CheckCookies is happy the user it gave us is authenticated...
+ if ($confirmed_by_cookie) {
+
+ # This WAS used to stop a pointless LookupExternalUserInfo
+ # called by UpdateFromExternal later on since it's already
+ # called by RT::User::Create if the user is autocreated
+ # but this has been deprecated pending a little bit of a
+ # rewrite since I realised that we're not calling
+ # CanonicalizeUserInfo but UpdateFromExternal which is the
+ # only code that checks whether the user is externally
+ # marked as disabled.
+ my $user_autocreated = 0;
+
+ # Create a new CurrentUser for the session and try and load
+ # a known user with the username given by the cookie check.
+ $session{'CurrentUser'} = RT::CurrentUser->new();
+ $session{'CurrentUser'}->Load($user);
+
+ # Unless we loaded a valid user with a UserID,
+ # autocreate a new user
+ unless ($session{'CurrentUser'}->Id) {
+
+ # Start with a new SystemUser
+ my $UserObj = RT::User->new($RT::SystemUser);
+
+ # Set the user's name to the one we were given
+ my ($val, $msg) = $UserObj->SetName($user);
+
+ # Commit the created user to the DB
+ ($val, $msg) =
+ $UserObj->Create(%{ref($RT::AutoCreate) ? $RT::AutoCreate : {}},
+ Name => $user,
+ Gecos => $user,
+ );
+
+ # Log the creation
+ $RT::Logger->info( "Autocreated authenticated user",
+ $UserObj->Name,
+ "(",
+ $UserObj->Id,
+ ")");
+
+ # Mark that user was created here so that we
+ # don't bother looking up their information
+ $user_autocreated = 1;
+
+ # Load the newly-created user as the CurrentUser in $session
+ # To RT, this means we now have a valid, authenticated user
+ $session{'CurrentUser'}->Load($user) if $UserObj->Id;
+ }
+
+
+ # If we now have a completely valid RT user to play with,
+ # and the user is not disabled in RT, then...
+ if ($session{'CurrentUser'} && $session{'CurrentUser'}->Id) {
+
+ # ALWAYS call UpdateFromExternal otherwise externally-disabled
+ # users could be allowed in.
+ $session{'CurrentUser'}->UserObj->UpdateFromExternal();
+
+ # Now their information is up to date,
+ # check if the user is disabled.
+
+ # If the user is disabled, kill their session,
+ # otherwise, authentication is successful.
+ if($session{'CurrentUser'}->UserObj->Disabled) {
+ delete $session{'CurrentUser'};
+ } else {
+ # Do not delete the session. User stays logged in.
+ # Log the success.
+ $RT::Logger->info( "Successful login for",
+ $user,
+ "from",
+ $ENV{'REMOTE_ADDR'});
+ }
+ } else {
+ # If we have no complete user.
+ delete $session{'CurrentUser'};
+ }
+ }
+ } else {
+ $RT::Logger->debug("RT is capable of External Cookie Auth, but it has not been enabled.");
+ }
+}
+
+############################################################
+############### EA #########################################
+############################################################
+#
# If the user is logging in, let's authenticate; if they can auth but don't load
# (e.g. they don't have an account but external auth succeeds), we'll autocreate
# their account.
diff --git a/lib/RT/Authen/ExternalAuth.pm b/lib/RT/Authen/ExternalAuth.pm
index 5a25ac1..2816836 100644
--- a/lib/RT/Authen/ExternalAuth.pm
+++ b/lib/RT/Authen/ExternalAuth.pm
@@ -20,6 +20,7 @@ our $VERSION = '0.07_03';
ok(require RT::Authen::ExternalAuth);
ok(require RT::Authen::ExternalAuth::LDAP);
ok(require RT::Authen::ExternalAuth::DBI);
+ok(require RT::Authen::ExternalAuth::Cookie);
=end testing
@@ -27,6 +28,7 @@ ok(require RT::Authen::ExternalAuth::DBI);
use RT::Authen::ExternalAuth::LDAP;
use RT::Authen::ExternalAuth::DBI;
+use RT::Authen::ExternalAuth::Cookie;
use Data::Dumper;
sub UpdateUserInfo {
@@ -346,4 +348,10 @@ sub CanonicalizeUserInfo {
return($found || $RT::AutoCreateNonExternalUsers);
}
+
+sub CheckCookies {
+
+ return RT::Authen::ExternalAuth::Cookie::CheckCookies();
+
+}
1;
diff --git a/lib/RT/Authen/ExternalAuth/DBI.pm b/lib/RT/Authen/ExternalAuth/DBI.pm
index b0633f0..245c2c7 100644
--- a/lib/RT/Authen/ExternalAuth/DBI.pm
+++ b/lib/RT/Authen/ExternalAuth/DBI.pm
@@ -312,7 +312,7 @@ sub UserDisabled {
sub _GetBoundDBIObj {
- # Config as hashref.
+ # Config as hashref. #### Or is this a hash?
my $config = shift;
# Extract the relevant information from the config.
diff --git a/lib/RT/Authen/ExternalAuth/DBI/Cookie.pm b/lib/RT/Authen/ExternalAuth/DBI/Cookie.pm
new file mode 100644
index 0000000..545f841
--- /dev/null
+++ b/lib/RT/Authen/ExternalAuth/DBI/Cookie.pm
@@ -0,0 +1,127 @@
+package RT::Authen::ExternalAuth::DBI::Cookie;
+
+use strict;
+use RT::Authen::ExternalAuth::DBI;
+use CGI::Cookie;
+
+# {{{ sub CheckCookies
+sub CheckCookies {
+
+# We are not a User object any more!
+# my $self = RT::User->new($RT::SystemUser);
+
+ $RT::Logger->debug( (caller(0))[3],
+ "Checking Browser Cookies for an Authenticated User");
+
+ my $confirmed_by_cookie = 0;
+ my $username; # $user changed to $username as not object but string
+
+ # Pull in all cookies from browser within our cookie domain
+ my %cookies = CGI::Cookie->fetch();
+
+ # Get our cookie and database info...
+ my $config = $RT::CookieSettings;
+
+ unless ($RT::UseExternalCookieAuthService){
+ $RT::Logger->debug( "External Cookie Auth is not enabled.",
+ "Please check your config for \$UseExternalCookieAuthService");
+ return (undef,0);
+ }
+
+ # The name of the cookie
+ my $cookie_name = $config->{'name'};
+
+ # If the cookie is set, get the value, if it's not set, get out now!
+ my $cookie_value;
+ if (defined $cookies{$cookie_name}) {
+ $cookie_value = $cookies{$cookie_name}->value;
+ $RT::Logger->debug( "Cookie Found!",
+ ":: $cookie_name ::",
+ "Attempting to use for authentication");
+ } else {
+ $RT::Logger->debug( "Cookie Auth Failed:",
+ "Cookie Not Assigned");
+ return ($user,$confirmed_by_cookie);
+ }
+
+ # The table mapping usernames to the Username Match Key
+ my $u_table = $config->{'u_table'};
+ # The username field in that table
+ my $u_field = $config->{'u_field'};
+ # The field that contains the Username Match Key
+ my $u_match_key = $config->{'u_match_key'};
+
+ # The table mapping cookie values to the Cookie Match Key
+ my $c_table = $config->{'c_table'};
+ # The cookie field in that table - The same as the cookie name if unspecified
+ my $c_field = $config->{'c_field'};
+ # The field that connects the Cookie Match Key
+ my $c_match_key = $config->{'c_match_key'};
+
+ # These are random characters to assign as table aliases in SQL
+ # It saves a lot of garbled code later on
+ my $u_table_alias = "u";
+ my $c_table_alias = "c";
+
+ # $tables will be passed straight into the SQL query
+ # I don't see this as a security issue as only the admin may modify the config file anyway
+ my $tables;
+
+ # If the tables are the same, then the aliases should be the same
+ # and the match key becomes irrelevant. Ensure this all works out
+ # fine by setting both sides the same. In either case, set an
+ # appropriate value for $tables.
+ if ($u_table eq $c_table) {
+ $u_table_alias = $c_table_alias;
+ $u_match_key = $c_match_key;
+ $tables = "$c_table $c_table_alias";
+ } else {
+ $tables = "$c_table $c_table_alias, $u_table $u_table_alias";
+ }
+
+ my $select_fields = "$u_table_alias.$u_field";
+ my $where_statement = "$c_table_alias.$c_field = ? AND $c_table_alias.$c_match_key = $u_table_alias.$u_match_key";
+
+ my $query = "SELECT $select_fields FROM $tables WHERE $where_statement";
+ my @params = ($cookie_value);
+ my $service = 'Auth';
+
+ # Use this if you need to debug the DBI SQL process
+ # DBI->trace(1,'/tmp/dbi.log');
+
+ my $dbh = RT::Authen::ExternalAuth::DBI::_GetBoundDBIObj($RT::ExternalSettings->{$config->{'db_service_name'}});
+ my $query_result_arrayref = $dbh->selectall_arrayref($query,{}, at params);
+ $dbh->disconnect();
+
+ # The log messages say it all here...
+ my $num_rows = scalar @$query_result_arrayref;
+ my $confirmed_user;
+ if ($num_rows < 1) {
+ $RT::Logger->info( "AUTH FAILED",
+ $cookie_name,
+ "Cookie value not found in database.",
+ "User passed an authentication token they were not given by us!",
+ "Is this nefarious activity?");
+ } elsif ($num_rows > 1) {
+ $RT::Logger->error( "AUTH FAILED",
+ $cookie_name,
+ "Cookie's value is duplicated in the database! This should not happen!!");
+ } else {
+ $user = $query_result_arrayref->[0][0];
+ $confirmed_by_cookie = 1;
+ }
+
+ if ($confirmed_by_cookie == 1) {
+ $RT::Logger->debug( "User (",
+ $user,
+ ") was authenticated by a browser cookie");
+ } else {
+ $RT::Logger->debug( "No user was authenticated by browser cookie");
+ }
+
+ return ($user,$confirmed_by_cookie);
+}
+
+# }}}
+
+1;
commit ee40af4ba830283a2b39cf4b2290a2f40e8c2bdb
Author: Mike Peachey <zordrak at cpan.org>
Date: Fri Jan 16 12:57:44 2009 +0000
RT::Authen::ExternalAuth // 2009-01-16 Zordrak <zordrak at cpan.org> // CookieAuth module refactoring predominantly complete, work required on the Auth callback to properly integrate it
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@17777 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/lib/RT/Authen/ExternalAuth.pm b/lib/RT/Authen/ExternalAuth.pm
index 2816836..173b7ff 100644
--- a/lib/RT/Authen/ExternalAuth.pm
+++ b/lib/RT/Authen/ExternalAuth.pm
@@ -351,7 +351,7 @@ sub CanonicalizeUserInfo {
sub CheckCookies {
- return RT::Authen::ExternalAuth::Cookie::CheckCookies();
+ return RT::Authen::ExternalAuth::DBI::CheckCookies();
}
1;
diff --git a/lib/RT/Authen/ExternalAuth/DBI.pm b/lib/RT/Authen/ExternalAuth/DBI.pm
index 245c2c7..a83582c 100644
--- a/lib/RT/Authen/ExternalAuth/DBI.pm
+++ b/lib/RT/Authen/ExternalAuth/DBI.pm
@@ -308,11 +308,110 @@ sub UserDisabled {
return 0;
}
+sub GetCookieAuth {
+
+ $RT::Logger->debug( (caller(0))[3],
+ "Checking Browser Cookies for an Authenticated User");
+
+ my $username = undef;
+
+ # Get our cookie and database info...
+ my $config = $RT::CookieSettings;
+
+ unless ($RT::UseExternalCookieAuthService){
+ $RT::Logger->debug( "External Cookie Auth is not enabled.",
+ "Please check your config for \$UseExternalCookieAuthService");
+ return $username;
+ }
+
+ my $cookie_value = RT::Authen::ExternalAuth::DBI::Cookie::GetCookieVal($config->{'name'});
+ unless($cookie_value){
+ return $username;
+ }
+
+ # The table mapping usernames to the Username Match Key
+ my $u_table = $config->{'u_table'};
+ # The username field in that table
+ my $u_field = $config->{'u_field'};
+ # The field that contains the Username Match Key
+ my $u_match_key = $config->{'u_match_key'};
+
+ # The table mapping cookie values to the Cookie Match Key
+ my $c_table = $config->{'c_table'};
+ # The cookie field in that table - The same as the cookie name if unspecified
+ my $c_field = $config->{'c_field'};
+ # The field that connects the Cookie Match Key
+ my $c_match_key = $config->{'c_match_key'};
+
+ # These are random characters to assign as table aliases in SQL
+ # It saves a lot of garbled code later on
+ my $u_table_alias = "u";
+ my $c_table_alias = "c";
+
+ # $tables will be passed straight into the SQL query
+ # I don't see this as a security issue as only the admin may modify the config file anyway
+ my $tables;
+
+ # If the tables are the same, then the aliases should be the same
+ # and the match key becomes irrelevant. Ensure this all works out
+ # fine by setting both sides the same. In either case, set an
+ # appropriate value for $tables.
+ if ($u_table eq $c_table) {
+ $u_table_alias = $c_table_alias;
+ $u_match_key = $c_match_key;
+ $tables = "$c_table $c_table_alias";
+ } else {
+ $tables = "$c_table $c_table_alias, $u_table $u_table_alias";
+ }
+
+ my $select_fields = "$u_table_alias.$u_field";
+ my $where_statement = "$c_table_alias.$c_field = ? AND $c_table_alias.$c_match_key = $u_table_alias.$u_match_key";
+
+ my $query = "SELECT $select_fields FROM $tables WHERE $where_statement";
+ my @params = ($cookie_value);
+ my $service = 'Auth';
+
+ # Use this if you need to debug the DBI SQL process
+ # DBI->trace(1,'/tmp/dbi.log');
+
+ my $dbh = _GetBoundDBIObj($RT::ExternalSettings->{$config->{'db_service_name'}});
+ my $query_result_arrayref = $dbh->selectall_arrayref($query,{}, at params);
+ $dbh->disconnect();
+
+ # The log messages say it all here...
+ my $num_rows = scalar @$query_result_arrayref;
+ if ($num_rows < 1) {
+ $RT::Logger->info( "AUTH FAILED",
+ $cookie_name,
+ "Cookie value not found in database.",
+ "User passed an authentication token they were not given by us!",
+ "Is this nefarious activity?");
+ } elsif ($num_rows > 1) {
+ $RT::Logger->error( "AUTH FAILED",
+ $cookie_name,
+ "Cookie's value is duplicated in the database! This should not happen!!");
+ } else {
+ $username = $query_result_arrayref->[0][0];
+ }
+
+ if ($username) {
+ $RT::Logger->debug( "User (",
+ $username,
+ ") was authenticated by a browser cookie");
+ } else {
+ $RT::Logger->debug( "No user was authenticated by browser cookie");
+ }
+
+ return $username;
+
+}
+
+
# {{{ sub _GetBoundDBIObj
sub _GetBoundDBIObj {
- # Config as hashref. #### Or is this a hash?
+ # Config as hashref.
my $config = shift;
# Extract the relevant information from the config.
diff --git a/lib/RT/Authen/ExternalAuth/DBI/Cookie.pm b/lib/RT/Authen/ExternalAuth/DBI/Cookie.pm
index 545f841..331405e 100644
--- a/lib/RT/Authen/ExternalAuth/DBI/Cookie.pm
+++ b/lib/RT/Authen/ExternalAuth/DBI/Cookie.pm
@@ -1,125 +1,29 @@
package RT::Authen::ExternalAuth::DBI::Cookie;
use strict;
-use RT::Authen::ExternalAuth::DBI;
use CGI::Cookie;
-# {{{ sub CheckCookies
-sub CheckCookies {
+# {{{ sub GetCookieVal
+sub GetCookieVal {
-# We are not a User object any more!
-# my $self = RT::User->new($RT::SystemUser);
-
- $RT::Logger->debug( (caller(0))[3],
- "Checking Browser Cookies for an Authenticated User");
-
- my $confirmed_by_cookie = 0;
- my $username; # $user changed to $username as not object but string
+ # The name of the cookie
+ my $cookie_name = shift;
+ my $cookie_value;
# Pull in all cookies from browser within our cookie domain
my %cookies = CGI::Cookie->fetch();
- # Get our cookie and database info...
- my $config = $RT::CookieSettings;
-
- unless ($RT::UseExternalCookieAuthService){
- $RT::Logger->debug( "External Cookie Auth is not enabled.",
- "Please check your config for \$UseExternalCookieAuthService");
- return (undef,0);
- }
-
- # The name of the cookie
- my $cookie_name = $config->{'name'};
-
# If the cookie is set, get the value, if it's not set, get out now!
- my $cookie_value;
if (defined $cookies{$cookie_name}) {
$cookie_value = $cookies{$cookie_name}->value;
- $RT::Logger->debug( "Cookie Found!",
- ":: $cookie_name ::",
- "Attempting to use for authentication");
- } else {
- $RT::Logger->debug( "Cookie Auth Failed:",
- "Cookie Not Assigned");
- return ($user,$confirmed_by_cookie);
- }
-
- # The table mapping usernames to the Username Match Key
- my $u_table = $config->{'u_table'};
- # The username field in that table
- my $u_field = $config->{'u_field'};
- # The field that contains the Username Match Key
- my $u_match_key = $config->{'u_match_key'};
-
- # The table mapping cookie values to the Cookie Match Key
- my $c_table = $config->{'c_table'};
- # The cookie field in that table - The same as the cookie name if unspecified
- my $c_field = $config->{'c_field'};
- # The field that connects the Cookie Match Key
- my $c_match_key = $config->{'c_match_key'};
-
- # These are random characters to assign as table aliases in SQL
- # It saves a lot of garbled code later on
- my $u_table_alias = "u";
- my $c_table_alias = "c";
-
- # $tables will be passed straight into the SQL query
- # I don't see this as a security issue as only the admin may modify the config file anyway
- my $tables;
-
- # If the tables are the same, then the aliases should be the same
- # and the match key becomes irrelevant. Ensure this all works out
- # fine by setting both sides the same. In either case, set an
- # appropriate value for $tables.
- if ($u_table eq $c_table) {
- $u_table_alias = $c_table_alias;
- $u_match_key = $c_match_key;
- $tables = "$c_table $c_table_alias";
+ $RT::Logger->debug( "Cookie Found",
+ ":: $cookie_name");
} else {
- $tables = "$c_table $c_table_alias, $u_table $u_table_alias";
+ $RT::Logger->debug( "Cookie Not Found");
}
- my $select_fields = "$u_table_alias.$u_field";
- my $where_statement = "$c_table_alias.$c_field = ? AND $c_table_alias.$c_match_key = $u_table_alias.$u_match_key";
-
- my $query = "SELECT $select_fields FROM $tables WHERE $where_statement";
- my @params = ($cookie_value);
- my $service = 'Auth';
-
- # Use this if you need to debug the DBI SQL process
- # DBI->trace(1,'/tmp/dbi.log');
-
- my $dbh = RT::Authen::ExternalAuth::DBI::_GetBoundDBIObj($RT::ExternalSettings->{$config->{'db_service_name'}});
- my $query_result_arrayref = $dbh->selectall_arrayref($query,{}, at params);
- $dbh->disconnect();
-
- # The log messages say it all here...
- my $num_rows = scalar @$query_result_arrayref;
- my $confirmed_user;
- if ($num_rows < 1) {
- $RT::Logger->info( "AUTH FAILED",
- $cookie_name,
- "Cookie value not found in database.",
- "User passed an authentication token they were not given by us!",
- "Is this nefarious activity?");
- } elsif ($num_rows > 1) {
- $RT::Logger->error( "AUTH FAILED",
- $cookie_name,
- "Cookie's value is duplicated in the database! This should not happen!!");
- } else {
- $user = $query_result_arrayref->[0][0];
- $confirmed_by_cookie = 1;
- }
-
- if ($confirmed_by_cookie == 1) {
- $RT::Logger->debug( "User (",
- $user,
- ") was authenticated by a browser cookie");
- } else {
- $RT::Logger->debug( "No user was authenticated by browser cookie");
- }
+ return $cookie_value;
- return ($user,$confirmed_by_cookie);
}
# }}}
commit df938fb7aa6cc66e667e2d306231b194e9022bc4
Author: Mike Peachey <zordrak at cpan.org>
Date: Sun Jan 18 14:36:42 2009 +0000
* RT::Authen::ExternalAuth 0.08_01
* pre-alpha
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@17828 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/ChangeLog b/ChangeLog
index 1f8e22d..1d7a558 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,17 +1,77 @@
-v0.07_03 2009-01-16 Mike Peachey <zordrak at cpan.org>
+v0.08_01 2009-01-18 Mike Peachey <zordrak at cpan.org>
* ChangeLog
- Added entry for v0.07_01
+ Added entry for v0.08_01
+
+ Tabs-to-spaces conversion made where needed.
* lib/RT/Authen/ExternalAuth.pm
- Version updated to 0.07_03
+ Version updated to 0.08_01
+
+ DoAuth method created to inherit the work that used to be
+ performed by the Auth callback for autohandler.
+
+ GetAuth reduced to an interface. Its purpose is now just to
+ check what type of service was passed and then call the
+ GetAuth method from the right package.
+
+ SSO Cookie authentication now available following the
+ integration of RT::Authen::CookieAuth. Methods updated
+ to reflect the availability of this service.
+
+ * etc/RT_SiteConfig.pm
+
+ CookieAuth settings have been merged into the ExternalAuth
+ settings hash. Example from CookieAuth has been merged in.
+
+ 'auth' and 'info' settings have been deprecated and so have
+ been removed from the examples. The function they served has
+ been replaced by the ExternalAuthPriority and
+ ExternalInfoPriority variables.
+
+ * lib/RT/Authen/User_Vendor.pm
+
+ The override for the IsPassword method has been deprecated
+ and deleted. It is no longer necessary to do password tests
+ as a call to the User object. The equivalent function is
+ now provided by GetAuth in ExternalAuth.pm and is called
+ with an ExternalAuth service name, username and password.
+ Currently, this only needs to be called by DoAuth in
+ ExternalAuth.pm
+
+ While RT::Authen::ExternalAuth used to be used to integrate
+ internal RT authentication with an external method as a single
+ operation, this causes a lack of modularity. Now ExternalAuth
+ is only concerned with its own authentication methods and if
+ they fail then RT will decide to do fallback to internal
+ authentication on its own.
+
+ * html/Callbacks/ExternalAuth/autohandler/Auth
+
+ Workaround for RT versions 3.8.0 and 3.8.1 removed.
+ RT::Authen::ExternalAuth v0.08 will be officially compatible
+ only with versions 3.8.2 and up.
+
+ All functionality has been replaced by a call to ExternalAuth.pm's
+ DoAuth method. This is permitted by the passing of a reference to
+ the current session variable. DoAuth simply modifies that variable
+ as necessary to perform its function. Any data returned is purely
+ informational.
+
+ * README
+
+ Updated to include basic information on SSO cookies.
+
+ * Makefile.PL
+
+ Updated to reflect the integration of RT::Authen::CookieAuth.
v0.07_02 2008-12-22 Kevin Falcone <falcone at cpan.org>
* html/Callbacks/ExternalAuth/autohandler/Auth
-
+
Make the workaround needed for 3.8.1 work on 3.8.2
v0.07_01 2008-11-06 Mike Peachey <zordrak at cpan.org>
@@ -20,7 +80,7 @@ v0.07_01 2008-11-06 Mike Peachey <zordrak at cpan.org>
* ALL
Complete code refactoring and updates for RT-3.8.x
- compatability.
+ compatability.
v0.06 2008-11-01 Mike Peachey <zordrak at cpan.org>
diff --git a/MANIFEST b/MANIFEST
index d071315..0673a83 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -13,6 +13,7 @@ inc/Module/Install/WriteAll.pm
lib/RT/Authen/ExternalAuth.pm
lib/RT/Authen/ExternalAuth/DBI.pm
lib/RT/Authen/ExternalAuth/LDAP.pm
+lib/RT/Authen/ExternalAuth/DBI/Cookie.pm
lib/RT/User_Vendor.pm
LICENSE
Makefile.PL
diff --git a/Makefile.PL b/Makefile.PL
index ad8b320..2ad8ebf 100755
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -18,6 +18,9 @@ features(
'Net::LDAP' => 0],
'External DBI Sources' => [
-default => 1,
- 'DBI' => 0]
+ 'DBI' => 0],
+ 'SSO Cookie Sources' => [
+ -default => 1,
+ 'CGI::Cookies' => 0]
);
&WriteAll;
diff --git a/README b/README
index 28c8d1d..0e613cb 100644
--- a/README
+++ b/README
@@ -20,6 +20,12 @@ But it has been designed so that it should work with ANY
LDAP service and ANY DBI-drivable database, based upon the
configuration given in your $RTHOME/etc/RT_SiteConfig.pm
+As of v0.08 ExternalAuth also allows you to pull a browser
+cookie value and test it against a DBI data source allowing
+the use of cookies for Single Sign-On (SSO) authentication.
+This is due to the merging of RT::Authen::ExternalAuth and
+RT::Authen::CookieAuth.
+
INSTALLATION
diff --git a/etc/RT_SiteConfig.pm b/etc/RT_SiteConfig.pm
index cc88b16..3a1252a 100644
--- a/etc/RT_SiteConfig.pm
+++ b/etc/RT_SiteConfig.pm
@@ -3,7 +3,8 @@
# if successfully confirmed by any service - no more services
# are checked.
Set($ExternalAuthPriority, [ 'My_LDAP',
- 'My_MySQL'
+ 'My_MySQL',
+ 'My_SSO_Cookie'
]
);
@@ -11,7 +12,10 @@ Set($ExternalAuthPriority, [ 'My_LDAP',
# should be used to get information about users. This includes
# RealName, Tel numbers etc, but also whether or not the user
# should be considered disabled.
+#
# Once user info is found, no more services are checked.
+#
+# You CANNOT use a SSO cookie for authentication.
Set($ExternalInfoPriority, [ 'My_MySQL',
'My_LDAP'
]
@@ -35,12 +39,8 @@ Set($AutoCreateNonExternalUsers, 0);
#
Set($ExternalSettings, { # AN EXAMPLE DB SERVICE
'My_MySQL' => { ## GENERIC SECTION
- # The type of service (db/ldap)
+ # The type of service (db/ldap/cookie)
'type' => 'db',
- # Should the service be used for authentication?
- 'auth' => 1,
- # Should the service be used for information?
- 'info' => 1,
# The server hosting the service
'server' => 'server.domain.tld',
## SERVICE-SPECIFIC SECTION
@@ -91,10 +91,6 @@ Set($ExternalSettings, { # AN EXAMPLE DB SERVICE
'My_LDAP' => { ## GENERIC SECTION
# The type of service (db/ldap/cookie)
'type' => 'ldap',
- # Should the service be used for authentication?
- 'auth' => 1,
- # Should the service be used for information?
- 'info' => 1,
# The server hosting the service
'server' => 'server.domain.tld',
## SERVICE-SPECIFIC SECTION
@@ -153,6 +149,28 @@ Set($ExternalSettings, { # AN EXAMPLE DB SERVICE
'Country' => 'co'
}
}
+ # An example SSO cookie service
+ 'My_SSO_Cookie' => { # # The type of service (db/ldap/cookie)
+ 'type' => 'cookie',
+ # The name of the cookie to be used
+ 'name' => 'loginCookieValue',
+ # The users table
+ 'u_table' => 'users',
+ # The username field in the users table
+ 'u_field' => 'username',
+ # The field in the users table that uniquely identifies a user
+ # and also exists in the cookies table
+ 'u_match_key' => 'userID',
+ # The cookies table
+ 'c_table' => 'login_cookie',
+ # The field that stores cookie values
+ 'c_field' => 'loginCookieValue',
+ # The field in the cookies table that uniquely identifies a user
+ # and also exists in the users table
+ 'c_match_key' => 'loginCookieUserID',
+ # The DB service in this configuration to use to lookup the cookie information
+ 'db_service_name' => 'My_MySQL'
+ }
}
);
diff --git a/html/Callbacks/ExternalAuth/autohandler/Auth b/html/Callbacks/ExternalAuth/autohandler/Auth
index e97dc99..179f15a 100644
--- a/html/Callbacks/ExternalAuth/autohandler/Auth
+++ b/html/Callbacks/ExternalAuth/autohandler/Auth
@@ -1,242 +1,9 @@
-<%once>
-my $loaded_user = 0;
-</%once>
<%init>
-
use RT::Authen::ExternalAuth;
-######################################################################################
-# Work around a bug in the RT 3.8.0 and 3.8.1 plugin system (fixed in 3.8.2)
-# Temporarily force RT to reload RT::User, since it isn't being loaded
-# correctly as a plugin.
-unless ($loaded_user) {
- $RT::Logger->error("Working around bug in RT and reloading RT::User");
- $loaded_user++;
- delete $INC{'RT/User.pm'};
- delete $INC{'RT/User_Overlay.pm'};
- delete $INC{'RT/User_Vendor.pm'};
- require RT::User;
-}
-######################################################################################
-
-
-
-##########################################################
-##################### CA #################################
-##########################################################
-#
-# If the user is logging in, let's authenticate; if they can auth but don't load
-# (e.g. they don't have an account but external auth succeeds), we'll autocreate
-# their account.
-unless ($session{'CurrentUser'}) {
-
- # Check to see if we've been asked to authenticate from cookies
- # If so, confirm the username authenticated by the cookies
- if ($RT::UseExternalCookieAuthService){
- $RT::Logger->debug( "Cookie Authentication (",
- $RT::UseExternalCookieAuthService,
- ") requested");
-
- # Use the package we need for cookie authentication
-
- my ($cookie_user, $confirmed_by_cookie) = RT::Authen::ExternalAuth::CheckCookies();
-
- # If CheckCookies gave us a user, set it as the global user.
- $user = $cookie_user if defined($cookie_user);
-
- # If CheckCookies is happy the user it gave us is authenticated...
- if ($confirmed_by_cookie) {
-
- # This WAS used to stop a pointless LookupExternalUserInfo
- # called by UpdateFromExternal later on since it's already
- # called by RT::User::Create if the user is autocreated
- # but this has been deprecated pending a little bit of a
- # rewrite since I realised that we're not calling
- # CanonicalizeUserInfo but UpdateFromExternal which is the
- # only code that checks whether the user is externally
- # marked as disabled.
- my $user_autocreated = 0;
-
- # Create a new CurrentUser for the session and try and load
- # a known user with the username given by the cookie check.
- $session{'CurrentUser'} = RT::CurrentUser->new();
- $session{'CurrentUser'}->Load($user);
-
- # Unless we loaded a valid user with a UserID,
- # autocreate a new user
- unless ($session{'CurrentUser'}->Id) {
-
- # Start with a new SystemUser
- my $UserObj = RT::User->new($RT::SystemUser);
-
- # Set the user's name to the one we were given
- my ($val, $msg) = $UserObj->SetName($user);
-
- # Commit the created user to the DB
- ($val, $msg) =
- $UserObj->Create(%{ref($RT::AutoCreate) ? $RT::AutoCreate : {}},
- Name => $user,
- Gecos => $user,
- );
-
- # Log the creation
- $RT::Logger->info( "Autocreated authenticated user",
- $UserObj->Name,
- "(",
- $UserObj->Id,
- ")");
-
- # Mark that user was created here so that we
- # don't bother looking up their information
- $user_autocreated = 1;
-
- # Load the newly-created user as the CurrentUser in $session
- # To RT, this means we now have a valid, authenticated user
- $session{'CurrentUser'}->Load($user) if $UserObj->Id;
- }
-
-
- # If we now have a completely valid RT user to play with,
- # and the user is not disabled in RT, then...
- if ($session{'CurrentUser'} && $session{'CurrentUser'}->Id) {
-
- # ALWAYS call UpdateFromExternal otherwise externally-disabled
- # users could be allowed in.
- $session{'CurrentUser'}->UserObj->UpdateFromExternal();
-
- # Now their information is up to date,
- # check if the user is disabled.
-
- # If the user is disabled, kill their session,
- # otherwise, authentication is successful.
- if($session{'CurrentUser'}->UserObj->Disabled) {
- delete $session{'CurrentUser'};
- } else {
- # Do not delete the session. User stays logged in.
- # Log the success.
- $RT::Logger->info( "Successful login for",
- $user,
- "from",
- $ENV{'REMOTE_ADDR'});
- }
- } else {
- # If we have no complete user.
- delete $session{'CurrentUser'};
- }
- }
- } else {
- $RT::Logger->debug("RT is capable of External Cookie Auth, but it has not been enabled.");
- }
-}
-
-############################################################
-############### EA #########################################
-############################################################
-#
-# If the user is logging in, let's authenticate; if they can auth but don't load
-# (e.g. they don't have an account but external auth succeeds), we'll autocreate
-# their account.
-unless ($session{'CurrentUser'}) {
-
- # Password has not been confirmed valid until we say so
- my $password_validated = 0;
-
- # If $user has been passed by login page,
- # or any other custom code previous to this
- if (defined ($user)) {
- $session{'CurrentUser'} = RT::CurrentUser->new();
-
- # Does user exist internally?
- $session{'CurrentUser'}->Load($user);
-
- # Unless we have loaded a valid user with a UserID
- # check if user exists externally and autocreate if it does
- unless ($session{'CurrentUser'}->Id) {
- if(RT::Authen::ExternalAuth::UserExists($user)){
- my $UserObj = RT::User->new($RT::SystemUser);
- my ($val, $msg) =
- $UserObj->Create(%{ref($RT::AutoCreate) ? $RT::AutoCreate : {}},
- Name => $user,
- Gecos => $user,
- );
- unless ($val) {
- $RT::Logger->error( "Couldn't create user $user: $msg" );
- return;
- }
- $RT::Logger->info( "Autocreated external user",
- $UserObj->Name,
- "(",
- $UserObj->Id,
- ")");
-
- $RT::Logger->debug("Loading new user (",
- $user,
- ") into current session");
- $session{'CurrentUser'}->Load($user);
- }
- }
- }
-
- # If we now have a completely valid RT user to play with...
- if ($session{'CurrentUser'} && $session{'CurrentUser'}->Id) {
-
- # If a password was given on the login page, validate it
- if (defined($pass)) {
- $RT::Logger->debug("\$pass defined ($pass), Running IsPassword");
- $password_validated = $session{'CurrentUser'}->UserObj->IsPassword($pass);
- }
-
- unless($password_validated) {
- $RT::Logger->debug("Password Incorrect");
- delete $session{'CurrentUser'};
- }
- }
-
- # If we STILL have a completely valid RT user to play with...
- # and therefore password has been validated...
- if ($session{'CurrentUser'} && $session{'CurrentUser'}->Id) {
-
- # Even if we have JUST created the user in RT, we are going to
- # reload their information from an external source. This allows us
- # to be sure that the user the cookie gave us really does exist in
- # the database, but more importantly, UpdateFromExternal will check
- # whether the user is disabled or not which we have not been able to
- # do during auto-create
- my ($updated,$update_msg) = RT::Authen::ExternalAuth::UpdateUserInfo($session{'CurrentUser'}->Name);
-
- # Now that we definitely have up-to-date user information,
- # if the user is disabled, kick them out. Now!
- if ($session{'CurrentUser'}->UserObj->Disabled) {
- delete $session{'CurrentUser'};
- }
- }
- # Original thank to Walter Duncan for these session deletes.
-
- # If the user has already been authenticated successfully above
- # then all is well, log the successful user auth
- # Else, ensure the session dies.
-
- # We will not check the password here, because this will be
- # done by the autohandler this Callback is extending if
- # we delete the session.
-
- # If we **STILL** have a full user and the session hasn't already been deleted
- if ($session{'CurrentUser'} && $session{'CurrentUser'}->Id) {
- # Sanity check
- if($password_validated) {
-
- $RT::Logger->info( "Successful login for",
- $user,
- "from",
- $ENV{'REMOTE_ADDR'});
- # Do not delete the session. User stays logged in and
- # autohandler will not check the password again
- } else {
- # Make SURE the session is deleted.
- delete $session{'CurrentUser'};
- # This will cause autohandler to request IsPassword
- # which will in turn call IsExternalPassword
- }
- }
+my ($val,$msg);
+unless($session{'CurrentUser'}->Id) {
+ ($val,$msg) = RT::Authen::ExternalAuth::DoAuth(\$session,\$user,\$pass);
+ # Success if $val == 1
}
return;
</%init>
diff --git a/lib/RT/Authen/ExternalAuth.pm b/lib/RT/Authen/ExternalAuth.pm
index 173b7ff..1f784ad 100644
--- a/lib/RT/Authen/ExternalAuth.pm
+++ b/lib/RT/Authen/ExternalAuth.pm
@@ -1,6 +1,6 @@
package RT::Authen::ExternalAuth;
-our $VERSION = '0.07_03';
+our $VERSION = '0.08_01';
=head1 NAME
@@ -18,9 +18,6 @@ our $VERSION = '0.07_03';
=begin testing
ok(require RT::Authen::ExternalAuth);
-ok(require RT::Authen::ExternalAuth::LDAP);
-ok(require RT::Authen::ExternalAuth::DBI);
-ok(require RT::Authen::ExternalAuth::Cookie);
=end testing
@@ -28,9 +25,174 @@ ok(require RT::Authen::ExternalAuth::Cookie);
use RT::Authen::ExternalAuth::LDAP;
use RT::Authen::ExternalAuth::DBI;
-use RT::Authen::ExternalAuth::Cookie;
+
use Data::Dumper;
+sub DoAuth {
+ my ($session,$given_user,$given_pass) = shift;
+
+ # This may be used by single sign-on (SSO) authentication mechanisms for bypassing a password check.
+ my $pass_bypass = 0;
+
+ # Should have checked if user is already logged in before calling this function,
+ # but just in case, we'll check too.
+ return (0, "User already logged in!") if $session{'CurrentUser'}->Id;
+ # We don't have a logged in user. Let's try all our available methods in order.
+ # last if success, next if not.
+
+ # Get the prioritised list of external authentication services
+ my @auth_services = @$RT::ExternalAuthPriority;
+
+ # For each of those services..
+ foreach my $service (@auth_services) {
+
+ # Get the full configuration for that service as a hashref
+ my $config = $RT::ExternalSettings->{$service};
+ $RT::Logger->debug( "Attempting to use external auth service:",
+ $service);
+
+ # $username will be the final username we decide to check
+ # This will not necessarily be $given_user
+ my $username = undef;
+
+ #############################################################
+ ####################### SSO Check ###########################
+ #############################################################
+ if ($config->{'type'} eq 'cookie') {
+ # Currently, Cookie authentication is our only SSO method
+ $username = RT::Authen::ExternalAuth::DBI::GetCookieAuth();
+ }
+ #############################################################
+
+ # If $username is defined, we have a good SSO $username and can
+ # safely bypass the password checking later on; primarily because
+ # it's VERY unlikely we even have a password to check if an SSO succeeded.
+ if defined($username) {
+ $pass_bypass = 1;
+ } else {
+ # We don't have an SSO login, so we will be using the credentials given
+ # on RT's login page to do our authentication.
+ $username = $given_user
+
+ # Don't continue unless the service works.
+ next unless RT::Authen::ExternalAuth::TestConnection($config);
+
+ # Don't continue unless the $username exists in the external service
+ next unless RT::Authen::ExternalAuth::CheckExist($username, $config);
+ }
+
+ ####################################################################
+ ########## Load / Auto-Create ######################################
+ ####################################################################
+ # We are now sure that we're talking about a valid RT user.
+ # If the user already exists, load up their info. If they don't
+ # then we need to create the user in RT.
+
+ # Does user already exist internally to RT?
+ $session{'CurrentUser'} = RT::CurrentUser->new();
+ $session{'CurrentUser'}->Load($user);
+
+ # Unless we have loaded a valid user with a UserID create one.
+ unless ($session{'CurrentUser'}->Id) {
+ my $UserObj = RT::User->new($RT::SystemUser);
+ my ($val, $msg) =
+ $UserObj->Create(%{ref($RT::AutoCreate) ? $RT::AutoCreate : {}},
+ Name => $user,
+ Gecos => $user,
+ );
+ unless ($val) {
+ $RT::Logger->error( "Couldn't create user $user: $msg" );
+ next;
+ }
+ $RT::Logger->info( "Autocreated external user",
+ $UserObj->Name,
+ "(",
+ $UserObj->Id,
+ ")");
+
+ $RT::Logger->debug("Loading new user (",
+ $user,
+ ") into current session");
+ $session{'CurrentUser'}->Load($user);
+ }
+
+ ####################################################################
+ ########## Authentication ##########################################
+ ####################################################################
+ # If we successfully used an SSO service, then authentication
+ # succeeded. If we didn't then, success is determined by a password
+ # test.
+ my $success;
+ if($pass_bypass) {
+ $success = 1;
+ } else {
+ $success = RT::Authen::ExternalAuth::GetAuth($service,$username,$given_pass);
+ }
+
+ # If the password check succeeded then this is our authoritative service
+ # and we proceed to user information update and login.
+ last if $success;
+ }
+
+ # If we got here and don't have a user loaded we must have failed to
+ # get a full, valid user from an authoritative external source.
+ unless ($session{'CurrentUser'} && $session{'CurrentUser'}->Id) {
+ delete $session{'CurrentUser'};
+ return (0, "Failed to authenticate externally");
+ }
+
+ # Otherwise we succeeded.
+ $RT::Logger->debug("Authentication successful. Now updating user information and attempting login.");
+
+ ####################################################################################################
+ ############################### The following is auth-method agnostic ##############################
+ ####################################################################################################
+
+ # If we STILL have a completely valid RT user to play with...
+ # and therefore password has been validated...
+ if ($session{'CurrentUser'} && $session{'CurrentUser'}->Id) {
+
+ # Even if we have JUST created the user in RT, we are going to
+ # reload their information from an external source. This allows us
+ # to be sure that the user the cookie gave us really does exist in
+ # the database, but more importantly, UpdateFromExternal will check
+ # whether the user is disabled or not which we have not been able to
+ # do during auto-create
+
+ # Note that UpdateUserInfo does not care how we authenticated the user
+ # It will look up user info from whatever is specified in $RT::ExternalInfoPriority
+ my ($updated,$update_msg) = RT::Authen::ExternalAuth::UpdateUserInfo($session{'CurrentUser'}->Name);
+
+ # Now that we definitely have up-to-date user information,
+ # if the user is disabled, kick them out. Now!
+ if ($session{'CurrentUser'}->UserObj->Disabled) {
+ delete $session{'CurrentUser'};
+ return (0, "User account disabled, login denied");
+ }
+ }
+
+ # If we **STILL** have a full user and the session hasn't already been deleted
+ # This If/Else is logically unnecessary, but it doesn't hurt to leave it here
+ # just in case. Especially to be a double-check to future modifications.
+ if ($session{'CurrentUser'} && $session{'CurrentUser'}->Id) {
+
+ $RT::Logger->info( "Successful login for",
+ $user,
+ "from",
+ $ENV{'REMOTE_ADDR'});
+ # Do not delete the session. User stays logged in and
+ # autohandler will not check the password again
+ } else {
+ # Make SURE the session is deleted.
+ delete $session{'CurrentUser'};
+ return (0, "Failed to authenticate externally");
+ # This will cause autohandler to request IsPassword
+ # which will in turn call IsExternalPassword
+ }
+
+ return (1, "Successful login");
+}
+
sub UpdateUserInfo {
my $username = shift;
@@ -110,70 +272,29 @@ sub UpdateUserInfo {
return ($updated, $msg);
}
-sub UserExists {
-
- my $username = shift;
- my $user_exists_externally = 0;
-
- my @auth_services = @$RT::ExternalAuthPriority;
-
- foreach my $service (@auth_services) {
- my $config = $RT::ExternalSettings->{$service};
+sub GetAuth {
- if ($config->{'type'} eq 'db') {
- $user_exists_externally = RT::Authen::ExternalAuth::DBI::UserExists($username,$service);
- last if $user_exists_externally;
- } elsif ($config->{'type'} eq 'ldap') {
- $user_exists_externally = RT::Authen::ExternalAuth::LDAP::UserExists($username,$service);
- last if $user_exists_externally;
- } else {
- $RT::Logger->error("Invalid type specification (",
- $config->{'type'},
- ") in config for service:",
- $service);
- }
- }
+ # Request a username/password check from the specified service
+ # This is only valid for non-SSO services.
- return $user_exists_externally;
-}
-
-sub GetAuth {
+ my ($service,$username,$password) = @_;
- my ($username,$password) = @_;
+ my $success = 0;
- # Get the prioritised list of external authentication services
- my @auth_services = @$RT::ExternalAuthPriority;
+ # Get the full configuration for that service as a hashref
+ my $config = $RT::ExternalSettings->{$service};
- # For each of those services..
- foreach my $service (@auth_services) {
-
- # Get the full configuration for that service as a hashref
- my $config = $RT::ExternalSettings->{$service};
- $RT::Logger->debug( "Attempting to use external auth service:",
- $service);
-
- # And then act accordingly depending on what type of service it is.
- # Right now, there is only code for DBI and LDAP services
- if ($config->{'type'} eq 'db') {
- my $success = RT::Authen::ExternalAuth::DBI::GetAuth($service,$username,$password);
- return 1 if $success;
- next;
-
- } elsif ($config->{'type'} eq 'ldap') {
- my $success = RT::Authen::ExternalAuth::LDAP::GetAuth($service,$username,$password);
- return 1 if $success;
- next;
-
- } else {
- $RT::Logger->error("Invalid type specification in config for service:",
- $service,
- "- Skipping...");
- }
+ # And then act accordingly depending on what type of service it is.
+ # Right now, there is only code for DBI and LDAP non-SSO services
+ if ($config->{'type'} eq 'db') {
+ $success = RT::Authen::ExternalAuth::DBI::GetAuth($service,$username,$password);
+ } elsif ($config->{'type'} eq 'ldap') {
+ $success = RT::Authen::ExternalAuth::LDAP::GetAuth($service,$username,$password);
+ } else {
+ $RT::Logger->error("Invalid service type for GetAuth:",$service);
}
- # No success by now = failure.
- return 0;
-
+ return $success;
}
sub UserDisabled {
@@ -225,7 +346,10 @@ sub UserDisabled {
next;
}
$user_disabled = RT::Authen::ExternalAuth::LDAP::UserDisabled($username,$service);
-
+
+ } elsif ($config->{'type'} eq 'cookie') {
+ RT::Logger->error("You cannot use SSO Cookies as an information service.");
+ next;
} else {
# The type of external service doesn't currently have any methods associated with it. Or it's a typo.
RT::Logger->error("Invalid type specification for config %config->{'name'}");
@@ -270,6 +394,11 @@ sub CanonicalizeUserInfo {
# Get the config for the service so that we know what attrs we can canonicalize
my $config = $RT::ExternalSettings->{$service};
+ if($config->{'type'} eq 'cookie'){
+ $RT::Logger->debug("You cannot use SSO cookies as an information service!");
+ next;
+ }
+
# For each attr we've been told to canonicalize in the match list
foreach my $rt_attr (@{$config->{'attr_match_list'}}) {
# Jump to the next attr in $args if this one isn't in the attr_match_list
@@ -349,9 +478,4 @@ sub CanonicalizeUserInfo {
}
-sub CheckCookies {
-
- return RT::Authen::ExternalAuth::DBI::CheckCookies();
-
-}
1;
diff --git a/lib/RT/Authen/ExternalAuth/DBI/Cookie.pm b/lib/RT/Authen/ExternalAuth/DBI/Cookie.pm
index 331405e..f691517 100644
--- a/lib/RT/Authen/ExternalAuth/DBI/Cookie.pm
+++ b/lib/RT/Authen/ExternalAuth/DBI/Cookie.pm
@@ -23,7 +23,6 @@ sub GetCookieVal {
}
return $cookie_value;
-
}
# }}}
diff --git a/lib/RT/User_Vendor.pm b/lib/RT/User_Vendor.pm
index dbb1006..bc7110c 100644
--- a/lib/RT/User_Vendor.pm
+++ b/lib/RT/User_Vendor.pm
@@ -2,73 +2,6 @@ no warnings qw(redefine);
use strict;
use RT::Authen::ExternalAuth;
-# {{{ sub IsPassword
-
-sub IsPassword {
- my $self = shift;
- my $value = shift;
-
- # TODO there isn't any apparent way to legitimately ACL this
-
- # RT does not allow null passwords
- if ( ( !defined($value) ) or ( $value eq '' ) ) {
- return (undef);
- }
-
- if ( $self->PrincipalObj && $self->PrincipalObj->Disabled ) {
- $RT::Logger->info("Disabled user " . $self->Name .
- " tried to log in" );
- return (undef);
- }
-
- $RT::Logger->debug("Trying External Authentication (",$self->Name,")");
- if(RT::Authen::ExternalAuth::GetAuth($self->Name,$value)) {
- $RT::Logger->debug( (caller(0))[3],
- "EXTERNAL AUTH OKAY");
- return(1);
- } else {
- $RT::Logger->debug( (caller(0))[3],
- "EXTERNAL AUTH FAILED");
- }
-
- unless ($self->HasPassword) {
- $RT::Logger->info( (caller(0))[3],
- "INTERNAL AUTH FAILED (no passwd):",
- $self->Name);
- return(undef);
- }
-
- # generate an md5 password
- if ($self->_GeneratePassword($value) eq $self->__Value('Password')) {
- $RT::Logger->info( (caller(0))[3],
- "INTERNAL AUTH OKAY:",
- $self->Name);
- return(1);
- }
-
- # if it's a historical password we say ok.
- if ($self->__Value('Password') eq crypt($value, $self->__Value('Password'))
- or $self->_GeneratePasswordBase64($value) eq $self->__Value('Password'))
- {
- # ...but upgrade the legacy password inplace.
- $self->SUPER::SetPassword( $self->_GeneratePassword($value) );
- $RT::Logger->info((caller(0))[3],
- "INTERNAL AUTH OKAY:",
- $self->Name);
- return(1);
- }
-
- $RT::Logger->info( (caller(0))[3],
- "INTERNAL AUTH FAILED:",
- $self->Name);
-
- # If we haven't succeeded by now, fail.
- return (undef);
-}
-
-# }}}
-
-
# {{{ sub CanonicalizeUserInfo
=head2 CanonicalizeUserInfo HASHREF
commit 0d64d4665f8ce66b4fcc3b5b45c6e90cb41d714e
Author: Mike Peachey <zordrak at cpan.org>
Date: Sun Jan 18 17:08:57 2009 +0000
RT::Authen::ExternalAuth v0.08_01 alpha. Not preserving %session on leaving ExternalAuth, but otherwise seemingly functional.
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@17829 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/etc/RT_SiteConfig.pm b/etc/RT_SiteConfig.pm
index 3a1252a..1700d08 100644
--- a/etc/RT_SiteConfig.pm
+++ b/etc/RT_SiteConfig.pm
@@ -148,7 +148,7 @@ Set($ExternalSettings, { # AN EXAMPLE DB SERVICE
'Zip' => 'postalCode',
'Country' => 'co'
}
- }
+ },
# An example SSO cookie service
'My_SSO_Cookie' => { # # The type of service (db/ldap/cookie)
'type' => 'cookie',
diff --git a/html/Callbacks/ExternalAuth/autohandler/Auth b/html/Callbacks/ExternalAuth/autohandler/Auth
index 179f15a..53050a5 100644
--- a/html/Callbacks/ExternalAuth/autohandler/Auth
+++ b/html/Callbacks/ExternalAuth/autohandler/Auth
@@ -1,10 +1,15 @@
<%init>
use RT::Authen::ExternalAuth;
+use Data::Dumper;
+
my ($val,$msg);
-unless($session{'CurrentUser'}->Id) {
- ($val,$msg) = RT::Authen::ExternalAuth::DoAuth(\$session,\$user,\$pass);
- # Success if $val == 1
+unless($session{'CurrentUser'} && $session{'CurrentUser'}->Id) {
+ $RT::Logger->debug("Calling DoAuth with \$user ($user) \$pass ($pass) %session (",Dumper(%session),")");
+ ($val,$msg) = RT::Authen::ExternalAuth::DoAuth(\%session,\$user,\$pass);
+ $RT::Logger->debug("Autohandler called ExternalAuth. Response: ($val, $msg)");
}
+
+$RT::Logger->debug("Leaving ExternalAuth autohandler Auth callback. Session:",Dumper(%session));
return;
</%init>
diff --git a/lib/RT/Authen/ExternalAuth.pm b/lib/RT/Authen/ExternalAuth.pm
index 1f784ad..3886bda 100644
--- a/lib/RT/Authen/ExternalAuth.pm
+++ b/lib/RT/Authen/ExternalAuth.pm
@@ -29,14 +29,22 @@ use RT::Authen::ExternalAuth::DBI;
use Data::Dumper;
sub DoAuth {
- my ($session,$given_user,$given_pass) = shift;
+ my ($session,$given_user,$given_pass) = @_;
+
+ $RT::Logger->debug("Entering DoAuth. Params == \$given_user (",
+ Dumper($given_user),
+ ") \$given_pass (",
+ Dumper($given_pass),
+ ") \%session (",
+ Dumper($session),
+ ")");
# This may be used by single sign-on (SSO) authentication mechanisms for bypassing a password check.
my $pass_bypass = 0;
# Should have checked if user is already logged in before calling this function,
# but just in case, we'll check too.
- return (0, "User already logged in!") if $session{'CurrentUser'}->Id;
+ return (0, "User already logged in!") if ($session{'CurrentUser'} && $session{'CurrentUser'}->Id);
# We don't have a logged in user. Let's try all our available methods in order.
# last if success, next if not.
@@ -60,25 +68,35 @@ sub DoAuth {
#############################################################
if ($config->{'type'} eq 'cookie') {
# Currently, Cookie authentication is our only SSO method
- $username = RT::Authen::ExternalAuth::DBI::GetCookieAuth();
+ $username = RT::Authen::ExternalAuth::DBI::GetCookieAuth($config);
}
#############################################################
# If $username is defined, we have a good SSO $username and can
# safely bypass the password checking later on; primarily because
# it's VERY unlikely we even have a password to check if an SSO succeeded.
- if defined($username) {
+ if(defined($username)) {
+ $RT::Logger->debug("Pass not going to be checked, attempting SSO");
$pass_bypass = 1;
} else {
+
+ # SSO failed and no $user was passed for a login attempt
+ # We only don't return here because the next iteration could be an SSO attempt
+ unless(defined($given_user)) {
+ $RT::Logger->debug("SSO Failed and no user to test with. Nexting");
+ }
+
# We don't have an SSO login, so we will be using the credentials given
# on RT's login page to do our authentication.
- $username = $given_user
+ $username = $given_user;
# Don't continue unless the service works.
- next unless RT::Authen::ExternalAuth::TestConnection($config);
+ # next unless RT::Authen::ExternalAuth::TestConnection($config);
# Don't continue unless the $username exists in the external service
- next unless RT::Authen::ExternalAuth::CheckExist($username, $config);
+
+ $RT::Logger->debug("Calling UserExists with \$username ($username) and \$service ($service)");
+ next unless RT::Authen::ExternalAuth::UserExists($username, $service);
}
####################################################################
@@ -90,18 +108,18 @@ sub DoAuth {
# Does user already exist internally to RT?
$session{'CurrentUser'} = RT::CurrentUser->new();
- $session{'CurrentUser'}->Load($user);
+ $session{'CurrentUser'}->Load($username);
# Unless we have loaded a valid user with a UserID create one.
unless ($session{'CurrentUser'}->Id) {
my $UserObj = RT::User->new($RT::SystemUser);
my ($val, $msg) =
$UserObj->Create(%{ref($RT::AutoCreate) ? $RT::AutoCreate : {}},
- Name => $user,
- Gecos => $user,
+ Name => $username,
+ Gecos => $username,
);
unless ($val) {
- $RT::Logger->error( "Couldn't create user $user: $msg" );
+ $RT::Logger->error( "Couldn't create user $username: $msg" );
next;
}
$RT::Logger->info( "Autocreated external user",
@@ -111,9 +129,9 @@ sub DoAuth {
")");
$RT::Logger->debug("Loading new user (",
- $user,
+ $username,
") into current session");
- $session{'CurrentUser'}->Load($user);
+ $session{'CurrentUser'}->Load($username);
}
####################################################################
@@ -177,7 +195,7 @@ sub DoAuth {
if ($session{'CurrentUser'} && $session{'CurrentUser'}->Id) {
$RT::Logger->info( "Successful login for",
- $user,
+ $username,
"from",
$ENV{'REMOTE_ADDR'});
# Do not delete the session. User stays logged in and
@@ -190,6 +208,7 @@ sub DoAuth {
# which will in turn call IsExternalPassword
}
+ $RT::Logger->debug("End of ExternalAuth DoAuth. State of \%session:",Dumper(%session));
return (1, "Successful login");
}
@@ -297,6 +316,31 @@ sub GetAuth {
return $success;
}
+sub UserExists {
+
+ # Request a username/password check from the specified service
+ # This is only valid for non-SSO services.
+
+ my ($service,$username) = @_;
+
+ my $success = 0;
+
+ # Get the full configuration for that service as a hashref
+ my $config = $RT::ExternalSettings->{$service};
+
+ # And then act accordingly depending on what type of service it is.
+ # Right now, there is only code for DBI and LDAP non-SSO services
+ if ($config->{'type'} eq 'db') {
+ $success = RT::Authen::ExternalAuth::DBI::UserExists($username,$service);
+ } elsif ($config->{'type'} eq 'ldap') {
+ $success = RT::Authen::ExternalAuth::LDAP::UserExists($username,$service);
+ } else {
+ $RT::Logger->debug("Invalid service type for UserExists:",$service);
+ }
+
+ return $success;
+}
+
sub UserDisabled {
my $username = shift;
diff --git a/lib/RT/Authen/ExternalAuth/DBI.pm b/lib/RT/Authen/ExternalAuth/DBI.pm
index a83582c..ddcdc5c 100644
--- a/lib/RT/Authen/ExternalAuth/DBI.pm
+++ b/lib/RT/Authen/ExternalAuth/DBI.pm
@@ -1,5 +1,6 @@
package RT::Authen::ExternalAuth::DBI;
use DBI;
+use RT::Authen::ExternalAuth::DBI::Cookie;
sub GetAuth {
@@ -316,13 +317,7 @@ sub GetCookieAuth {
my $username = undef;
# Get our cookie and database info...
- my $config = $RT::CookieSettings;
-
- unless ($RT::UseExternalCookieAuthService){
- $RT::Logger->debug( "External Cookie Auth is not enabled.",
- "Please check your config for \$UseExternalCookieAuthService");
- return $username;
- }
+ my $config = shift;
my $cookie_value = RT::Authen::ExternalAuth::DBI::Cookie::GetCookieVal($config->{'name'});
unless($cookie_value){
@@ -369,7 +364,6 @@ sub GetCookieAuth {
my $query = "SELECT $select_fields FROM $tables WHERE $where_statement";
my @params = ($cookie_value);
- my $service = 'Auth';
# Use this if you need to debug the DBI SQL process
# DBI->trace(1,'/tmp/dbi.log');
diff --git a/lib/RT/Authen/ExternalAuth/DBI/Cookie.pm b/lib/RT/Authen/ExternalAuth/DBI/Cookie.pm
index f691517..d72489a 100644
--- a/lib/RT/Authen/ExternalAuth/DBI/Cookie.pm
+++ b/lib/RT/Authen/ExternalAuth/DBI/Cookie.pm
@@ -2,6 +2,7 @@ package RT::Authen::ExternalAuth::DBI::Cookie;
use strict;
use CGI::Cookie;
+use Data::Dumper;
# {{{ sub GetCookieVal
sub GetCookieVal {
commit 58dd4913269c0139aa7cbdd682a63b65950f85ed
Author: Mike Peachey <zordrak at cpan.org>
Date: Sun Jan 18 20:55:42 2009 +0000
RT::Authen::ExternalAuth v0.08_01-alpha == First functional release candidate
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@17830 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/lib/RT/Authen/ExternalAuth.pm b/lib/RT/Authen/ExternalAuth.pm
index 3886bda..b552716 100644
--- a/lib/RT/Authen/ExternalAuth.pm
+++ b/lib/RT/Authen/ExternalAuth.pm
@@ -28,6 +28,9 @@ use RT::Authen::ExternalAuth::DBI;
use Data::Dumper;
+use strict;
+use warnings;
+
sub DoAuth {
my ($session,$given_user,$given_pass) = @_;
@@ -35,7 +38,7 @@ sub DoAuth {
Dumper($given_user),
") \$given_pass (",
Dumper($given_pass),
- ") \%session (",
+ ") \$session (",
Dumper($session),
")");
@@ -44,7 +47,7 @@ sub DoAuth {
# Should have checked if user is already logged in before calling this function,
# but just in case, we'll check too.
- return (0, "User already logged in!") if ($session{'CurrentUser'} && $session{'CurrentUser'}->Id);
+ return (0, "User already logged in!") if ($session->{'CurrentUser'} && $session->{'CurrentUser'}->Id);
# We don't have a logged in user. Let's try all our available methods in order.
# last if success, next if not.
@@ -107,11 +110,11 @@ sub DoAuth {
# then we need to create the user in RT.
# Does user already exist internally to RT?
- $session{'CurrentUser'} = RT::CurrentUser->new();
- $session{'CurrentUser'}->Load($username);
+ $session->{'CurrentUser'} = RT::CurrentUser->new();
+ $session->{'CurrentUser'}->Load($username);
# Unless we have loaded a valid user with a UserID create one.
- unless ($session{'CurrentUser'}->Id) {
+ unless ($session->{'CurrentUser'}->Id) {
my $UserObj = RT::User->new($RT::SystemUser);
my ($val, $msg) =
$UserObj->Create(%{ref($RT::AutoCreate) ? $RT::AutoCreate : {}},
@@ -131,7 +134,7 @@ sub DoAuth {
$RT::Logger->debug("Loading new user (",
$username,
") into current session");
- $session{'CurrentUser'}->Load($username);
+ $session->{'CurrentUser'}->Load($username);
}
####################################################################
@@ -154,8 +157,8 @@ sub DoAuth {
# If we got here and don't have a user loaded we must have failed to
# get a full, valid user from an authoritative external source.
- unless ($session{'CurrentUser'} && $session{'CurrentUser'}->Id) {
- delete $session{'CurrentUser'};
+ unless ($session->{'CurrentUser'} && $session->{'CurrentUser'}->Id) {
+ delete $session->{'CurrentUser'};
return (0, "Failed to authenticate externally");
}
@@ -168,7 +171,7 @@ sub DoAuth {
# If we STILL have a completely valid RT user to play with...
# and therefore password has been validated...
- if ($session{'CurrentUser'} && $session{'CurrentUser'}->Id) {
+ if ($session->{'CurrentUser'} && $session->{'CurrentUser'}->Id) {
# Even if we have JUST created the user in RT, we are going to
# reload their information from an external source. This allows us
@@ -179,12 +182,12 @@ sub DoAuth {
# Note that UpdateUserInfo does not care how we authenticated the user
# It will look up user info from whatever is specified in $RT::ExternalInfoPriority
- my ($updated,$update_msg) = RT::Authen::ExternalAuth::UpdateUserInfo($session{'CurrentUser'}->Name);
+ my ($updated,$update_msg) = RT::Authen::ExternalAuth::UpdateUserInfo($session->{'CurrentUser'}->Name);
# Now that we definitely have up-to-date user information,
# if the user is disabled, kick them out. Now!
- if ($session{'CurrentUser'}->UserObj->Disabled) {
- delete $session{'CurrentUser'};
+ if ($session->{'CurrentUser'}->UserObj->Disabled) {
+ delete $session->{'CurrentUser'};
return (0, "User account disabled, login denied");
}
}
@@ -192,23 +195,23 @@ sub DoAuth {
# If we **STILL** have a full user and the session hasn't already been deleted
# This If/Else is logically unnecessary, but it doesn't hurt to leave it here
# just in case. Especially to be a double-check to future modifications.
- if ($session{'CurrentUser'} && $session{'CurrentUser'}->Id) {
+ if ($session->{'CurrentUser'} && $session->{'CurrentUser'}->Id) {
$RT::Logger->info( "Successful login for",
- $username,
+ $session->{'CurrentUser'}->Name,
"from",
$ENV{'REMOTE_ADDR'});
# Do not delete the session. User stays logged in and
# autohandler will not check the password again
} else {
# Make SURE the session is deleted.
- delete $session{'CurrentUser'};
+ delete $session->{'CurrentUser'};
return (0, "Failed to authenticate externally");
# This will cause autohandler to request IsPassword
# which will in turn call IsExternalPassword
}
- $RT::Logger->debug("End of ExternalAuth DoAuth. State of \%session:",Dumper(%session));
+ $RT::Logger->debug("End of ExternalAuth DoAuth. State of \$session:",Dumper($session));
return (1, "Successful login");
}
diff --git a/lib/RT/Authen/ExternalAuth/DBI.pm b/lib/RT/Authen/ExternalAuth/DBI.pm
index ddcdc5c..65aa7d0 100644
--- a/lib/RT/Authen/ExternalAuth/DBI.pm
+++ b/lib/RT/Authen/ExternalAuth/DBI.pm
@@ -1,7 +1,11 @@
package RT::Authen::ExternalAuth::DBI;
+
use DBI;
use RT::Authen::ExternalAuth::DBI::Cookie;
+use strict;
+use warnings;
+
sub GetAuth {
my ($service, $username, $password) = @_;
@@ -314,12 +318,13 @@ sub GetCookieAuth {
$RT::Logger->debug( (caller(0))[3],
"Checking Browser Cookies for an Authenticated User");
- my $username = undef;
-
# Get our cookie and database info...
my $config = shift;
- my $cookie_value = RT::Authen::ExternalAuth::DBI::Cookie::GetCookieVal($config->{'name'});
+ my $username = undef;
+ my $cookie_name = $config->{'name'};
+
+ my $cookie_value = RT::Authen::ExternalAuth::DBI::Cookie::GetCookieVal($cookie_name);
unless($cookie_value){
return $username;
}
diff --git a/lib/RT/Authen/ExternalAuth/DBI/Cookie.pm b/lib/RT/Authen/ExternalAuth/DBI/Cookie.pm
index d72489a..e127a74 100644
--- a/lib/RT/Authen/ExternalAuth/DBI/Cookie.pm
+++ b/lib/RT/Authen/ExternalAuth/DBI/Cookie.pm
@@ -1,9 +1,11 @@
package RT::Authen::ExternalAuth::DBI::Cookie;
-use strict;
use CGI::Cookie;
use Data::Dumper;
+use strict;
+use warnings;
+
# {{{ sub GetCookieVal
sub GetCookieVal {
diff --git a/lib/RT/Authen/ExternalAuth/LDAP.pm b/lib/RT/Authen/ExternalAuth/LDAP.pm
index 53ee46e..537bef1 100644
--- a/lib/RT/Authen/ExternalAuth/LDAP.pm
+++ b/lib/RT/Authen/ExternalAuth/LDAP.pm
@@ -1,8 +1,13 @@
package RT::Authen::ExternalAuth::LDAP;
+
use Net::LDAP qw(LDAP_SUCCESS LDAP_PARTIAL_RESULTS);
use Net::LDAP::Util qw(ldap_error_name);
use Net::LDAP::Filter;
use Data::Dumper;
+
+use strict;
+use warnings;
+
require Net::SSLeay if $RT::ExternalServiceUsesSSLorTLS;
sub GetAuth {
@@ -390,7 +395,7 @@ sub UserDisabled {
# We only need the UID for confirmation now,
# the other information would waste time and bandwidth
- @attrs = ('uid');
+ my @attrs = ('uid');
$RT::Logger->debug( "LDAP Search === ",
"Base:",
commit d997c545d74e51eae09cc4e4a482b2da74042eb9
Author: Mike Peachey <zordrak at cpan.org>
Date: Sun Jan 18 21:38:36 2009 +0000
RT::Authen::ExternalAuth v0.08_01-alpha2 == Second functional release candidate. Only warnings, no failures.
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@17831 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/html/Callbacks/ExternalAuth/autohandler/Auth b/html/Callbacks/ExternalAuth/autohandler/Auth
index 53050a5..0981b4b 100644
--- a/html/Callbacks/ExternalAuth/autohandler/Auth
+++ b/html/Callbacks/ExternalAuth/autohandler/Auth
@@ -4,12 +4,10 @@ use Data::Dumper;
my ($val,$msg);
unless($session{'CurrentUser'} && $session{'CurrentUser'}->Id) {
- $RT::Logger->debug("Calling DoAuth with \$user ($user) \$pass ($pass) %session (",Dumper(%session),")");
- ($val,$msg) = RT::Authen::ExternalAuth::DoAuth(\%session,\$user,\$pass);
+ ($val,$msg) = RT::Authen::ExternalAuth::DoAuth(\%session,$user,$pass);
$RT::Logger->debug("Autohandler called ExternalAuth. Response: ($val, $msg)");
}
-$RT::Logger->debug("Leaving ExternalAuth autohandler Auth callback. Session:",Dumper(%session));
return;
</%init>
diff --git a/lib/RT/Authen/ExternalAuth.pm b/lib/RT/Authen/ExternalAuth.pm
index b552716..662dc40 100644
--- a/lib/RT/Authen/ExternalAuth.pm
+++ b/lib/RT/Authen/ExternalAuth.pm
@@ -26,22 +26,12 @@ ok(require RT::Authen::ExternalAuth);
use RT::Authen::ExternalAuth::LDAP;
use RT::Authen::ExternalAuth::DBI;
-use Data::Dumper;
-
use strict;
use warnings;
sub DoAuth {
my ($session,$given_user,$given_pass) = @_;
- $RT::Logger->debug("Entering DoAuth. Params == \$given_user (",
- Dumper($given_user),
- ") \$given_pass (",
- Dumper($given_pass),
- ") \$session (",
- Dumper($session),
- ")");
-
# This may be used by single sign-on (SSO) authentication mechanisms for bypassing a password check.
my $pass_bypass = 0;
@@ -98,8 +88,8 @@ sub DoAuth {
# Don't continue unless the $username exists in the external service
- $RT::Logger->debug("Calling UserExists with \$username ($username) and \$service ($service)");
- next unless RT::Authen::ExternalAuth::UserExists($username, $service);
+ my $user_exists = RT::Authen::ExternalAuth::UserExists($username,$service);
+ next unless $user_exists;
}
####################################################################
@@ -211,7 +201,6 @@ sub DoAuth {
# which will in turn call IsExternalPassword
}
- $RT::Logger->debug("End of ExternalAuth DoAuth. State of \$session:",Dumper($session));
return (1, "Successful login");
}
@@ -324,7 +313,7 @@ sub UserExists {
# Request a username/password check from the specified service
# This is only valid for non-SSO services.
- my ($service,$username) = @_;
+ my ($username,$service) = @_;
my $success = 0;
@@ -453,7 +442,7 @@ sub CanonicalizeUserInfo {
unless(defined($args->{$rt_attr})) {
$RT::Logger->debug("This attribute (",
$rt_attr,
- ") is not defined in the attr_match_list for this service (",
+ ") is not defined in the attr_match_list for this service, or is null (",
$service,
")");
next;
diff --git a/lib/RT/Authen/ExternalAuth/DBI/Cookie.pm b/lib/RT/Authen/ExternalAuth/DBI/Cookie.pm
index e127a74..67e0f29 100644
--- a/lib/RT/Authen/ExternalAuth/DBI/Cookie.pm
+++ b/lib/RT/Authen/ExternalAuth/DBI/Cookie.pm
@@ -1,7 +1,6 @@
package RT::Authen::ExternalAuth::DBI::Cookie;
use CGI::Cookie;
-use Data::Dumper;
use strict;
use warnings;
diff --git a/lib/RT/Authen/ExternalAuth/LDAP.pm b/lib/RT/Authen/ExternalAuth/LDAP.pm
index 537bef1..2bab802 100644
--- a/lib/RT/Authen/ExternalAuth/LDAP.pm
+++ b/lib/RT/Authen/ExternalAuth/LDAP.pm
@@ -3,7 +3,6 @@ package RT::Authen::ExternalAuth::LDAP;
use Net::LDAP qw(LDAP_SUCCESS LDAP_PARTIAL_RESULTS);
use Net::LDAP::Util qw(ldap_error_name);
use Net::LDAP::Filter;
-use Data::Dumper;
use strict;
use warnings;
@@ -179,7 +178,7 @@ sub CanonicalizeUserInfo {
$RT::Logger->debug( "LDAP Filter invalid or not present.");
}
- unless ($base) {
+ unless (defined($base)) {
$RT::Logger->critical( (caller(0))[3],
"No base given");
# Drop out to the next external information service
commit 719e18af1c0a9b9609c7b08e3c3e9905b749a0d8
Author: Mike Peachey <zordrak at cpan.org>
Date: Mon Jan 19 11:38:15 2009 +0000
RT::Authen::ExternalAuth v0.08_01-alpha3 -- Seemingly Complete
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@17833 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/html/Callbacks/ExternalAuth/autohandler/Auth b/html/Callbacks/ExternalAuth/autohandler/Auth
index 0981b4b..e1ce79f 100644
--- a/html/Callbacks/ExternalAuth/autohandler/Auth
+++ b/html/Callbacks/ExternalAuth/autohandler/Auth
@@ -1,6 +1,5 @@
<%init>
use RT::Authen::ExternalAuth;
-use Data::Dumper;
my ($val,$msg);
unless($session{'CurrentUser'} && $session{'CurrentUser'}->Id) {
diff --git a/lib/RT/Authen/ExternalAuth.pm b/lib/RT/Authen/ExternalAuth.pm
index 662dc40..d9479ce 100644
--- a/lib/RT/Authen/ExternalAuth.pm
+++ b/lib/RT/Authen/ExternalAuth.pm
@@ -27,14 +27,14 @@ use RT::Authen::ExternalAuth::LDAP;
use RT::Authen::ExternalAuth::DBI;
use strict;
-use warnings;
sub DoAuth {
my ($session,$given_user,$given_pass) = @_;
# This may be used by single sign-on (SSO) authentication mechanisms for bypassing a password check.
my $pass_bypass = 0;
-
+ my $success = 0;
+
# Should have checked if user is already logged in before calling this function,
# but just in case, we'll check too.
return (0, "User already logged in!") if ($session->{'CurrentUser'} && $session->{'CurrentUser'}->Id);
@@ -47,6 +47,8 @@ sub DoAuth {
# For each of those services..
foreach my $service (@auth_services) {
+ $pass_bypass = 0;
+
# Get the full configuration for that service as a hashref
my $config = $RT::ExternalSettings->{$service};
$RT::Logger->debug( "Attempting to use external auth service:",
@@ -68,7 +70,8 @@ sub DoAuth {
# If $username is defined, we have a good SSO $username and can
# safely bypass the password checking later on; primarily because
# it's VERY unlikely we even have a password to check if an SSO succeeded.
- if(defined($username)) {
+ $pass_bypass = 0;
+ if(defined($username)) {
$RT::Logger->debug("Pass not going to be checked, attempting SSO");
$pass_bypass = 1;
} else {
@@ -77,6 +80,7 @@ sub DoAuth {
# We only don't return here because the next iteration could be an SSO attempt
unless(defined($given_user)) {
$RT::Logger->debug("SSO Failed and no user to test with. Nexting");
+ next;
}
# We don't have an SSO login, so we will be using the credentials given
@@ -88,8 +92,8 @@ sub DoAuth {
# Don't continue unless the $username exists in the external service
- my $user_exists = RT::Authen::ExternalAuth::UserExists($username,$service);
- next unless $user_exists;
+ $RT::Logger->debug("Calling UserExists with \$username ($username) and \$service ($service)");
+ next unless RT::Authen::ExternalAuth::UserExists($username, $service);
}
####################################################################
@@ -133,13 +137,17 @@ sub DoAuth {
# If we successfully used an SSO service, then authentication
# succeeded. If we didn't then, success is determined by a password
# test.
- my $success;
- if($pass_bypass) {
+ $success = 0;
+ if($pass_bypass) {
+ $RT::Logger->debug("Password check bypassed due to SSO method being in use");
$success = 1;
} else {
+ $RT::Logger->debug("Password validation required for service - Executing...");
$success = RT::Authen::ExternalAuth::GetAuth($service,$username,$given_pass);
}
-
+
+ $RT::Logger->debug("Password Validation Check Result: ",$success);
+
# If the password check succeeded then this is our authoritative service
# and we proceed to user information update and login.
last if $success;
@@ -149,7 +157,12 @@ sub DoAuth {
# get a full, valid user from an authoritative external source.
unless ($session->{'CurrentUser'} && $session->{'CurrentUser'}->Id) {
delete $session->{'CurrentUser'};
- return (0, "Failed to authenticate externally");
+ return (0, "No User");
+ }
+
+ unless($success) {
+ delete $session->{'CurrentUser'};
+ return (0, "Password Invalid");
}
# Otherwise we succeeded.
@@ -299,8 +312,10 @@ sub GetAuth {
# Right now, there is only code for DBI and LDAP non-SSO services
if ($config->{'type'} eq 'db') {
$success = RT::Authen::ExternalAuth::DBI::GetAuth($service,$username,$password);
+ $RT::Logger->debug("DBI password validation result:",$success);
} elsif ($config->{'type'} eq 'ldap') {
$success = RT::Authen::ExternalAuth::LDAP::GetAuth($service,$username,$password);
+ $RT::Logger->debug("LDAP password validation result:",$success);
} else {
$RT::Logger->error("Invalid service type for GetAuth:",$service);
}
@@ -442,7 +457,7 @@ sub CanonicalizeUserInfo {
unless(defined($args->{$rt_attr})) {
$RT::Logger->debug("This attribute (",
$rt_attr,
- ") is not defined in the attr_match_list for this service, or is null (",
+ ") is null or incorrectly defined in the attr_map for this service (",
$service,
")");
next;
diff --git a/lib/RT/Authen/ExternalAuth/DBI.pm b/lib/RT/Authen/ExternalAuth/DBI.pm
index 65aa7d0..0f7726d 100644
--- a/lib/RT/Authen/ExternalAuth/DBI.pm
+++ b/lib/RT/Authen/ExternalAuth/DBI.pm
@@ -4,7 +4,6 @@ use DBI;
use RT::Authen::ExternalAuth::DBI::Cookie;
use strict;
-use warnings;
sub GetAuth {
@@ -325,6 +324,7 @@ sub GetCookieAuth {
my $cookie_name = $config->{'name'};
my $cookie_value = RT::Authen::ExternalAuth::DBI::Cookie::GetCookieVal($cookie_name);
+
unless($cookie_value){
return $username;
}
diff --git a/lib/RT/Authen/ExternalAuth/DBI/Cookie.pm b/lib/RT/Authen/ExternalAuth/DBI/Cookie.pm
index 67e0f29..3a2b0f3 100644
--- a/lib/RT/Authen/ExternalAuth/DBI/Cookie.pm
+++ b/lib/RT/Authen/ExternalAuth/DBI/Cookie.pm
@@ -3,7 +3,6 @@ package RT::Authen::ExternalAuth::DBI::Cookie;
use CGI::Cookie;
use strict;
-use warnings;
# {{{ sub GetCookieVal
sub GetCookieVal {
diff --git a/lib/RT/Authen/ExternalAuth/LDAP.pm b/lib/RT/Authen/ExternalAuth/LDAP.pm
index 2bab802..66021c3 100644
--- a/lib/RT/Authen/ExternalAuth/LDAP.pm
+++ b/lib/RT/Authen/ExternalAuth/LDAP.pm
@@ -5,7 +5,6 @@ use Net::LDAP::Util qw(ldap_error_name);
use Net::LDAP::Filter;
use strict;
-use warnings;
require Net::SSLeay if $RT::ExternalServiceUsesSSLorTLS;
@@ -178,7 +177,7 @@ sub CanonicalizeUserInfo {
$RT::Logger->debug( "LDAP Filter invalid or not present.");
}
- unless (defined($base)) {
+ unless ($base) {
$RT::Logger->critical( (caller(0))[3],
"No base given");
# Drop out to the next external information service
commit a70ea61f669da955d9a29114e603216b255a0000
Author: Mike Peachey <zordrak at cpan.org>
Date: Mon Jan 19 11:45:07 2009 +0000
RT::Authen::ExternalAuth v0.08_01-alpha4 - Empty BaseDN fix applied
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@17834 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/lib/RT/Authen/ExternalAuth/LDAP.pm b/lib/RT/Authen/ExternalAuth/LDAP.pm
index 66021c3..885c7dd 100644
--- a/lib/RT/Authen/ExternalAuth/LDAP.pm
+++ b/lib/RT/Authen/ExternalAuth/LDAP.pm
@@ -177,9 +177,9 @@ sub CanonicalizeUserInfo {
$RT::Logger->debug( "LDAP Filter invalid or not present.");
}
- unless ($base) {
+ unless (defined($base)) {
$RT::Logger->critical( (caller(0))[3],
- "No base given");
+ "LDAP baseDN not defined");
# Drop out to the next external information service
return ($found, %params);
}
commit f85573b009f2d3841a6856f8462a0ec94a117de7
Author: Mike Peachey <zordrak at cpan.org>
Date: Tue Jan 20 14:30:47 2009 +0000
RT::Authen::ExternalAuth v0.08_01-alpha5 - Added sanity checks for ExternalAuthPriority and ExternalInfoPriority
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@17838 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/lib/RT/Authen/ExternalAuth.pm b/lib/RT/Authen/ExternalAuth.pm
index d9479ce..be5fa08 100644
--- a/lib/RT/Authen/ExternalAuth.pm
+++ b/lib/RT/Authen/ExternalAuth.pm
@@ -31,6 +31,16 @@ use strict;
sub DoAuth {
my ($session,$given_user,$given_pass) = @_;
+ unless(defined($RT::ExternalAuthPriority)) {
+ return (0, "ExternalAuthPriority not defined, please check your configuration file.");
+ }
+
+ my $no_info_check = 0;
+ unless(defined($RT::ExternalInfoPriority)) {
+ $RT::Logger->debug("ExternalInfoPriority not defined. User information (including user enabled/disabled cannot be externally-sourced");
+ $no_info_check = 1;
+ }
+
# This may be used by single sign-on (SSO) authentication mechanisms for bypassing a password check.
my $pass_bypass = 0;
my $success = 0;
@@ -182,10 +192,16 @@ sub DoAuth {
# the database, but more importantly, UpdateFromExternal will check
# whether the user is disabled or not which we have not been able to
# do during auto-create
-
- # Note that UpdateUserInfo does not care how we authenticated the user
- # It will look up user info from whatever is specified in $RT::ExternalInfoPriority
- my ($updated,$update_msg) = RT::Authen::ExternalAuth::UpdateUserInfo($session->{'CurrentUser'}->Name);
+
+ # These are not currently used, but may be used in the future.
+ my $info_updated = 0;
+ my $info_updated_msg = "User info not updated";
+
+ unless($no_info_check) {
+ # Note that UpdateUserInfo does not care how we authenticated the user
+ # It will look up user info from whatever is specified in $RT::ExternalInfoPriority
+ ($info_updated,$info_updated_msg) = RT::Authen::ExternalAuth::UpdateUserInfo($session->{'CurrentUser'}->Name);
+ }
# Now that we definitely have up-to-date user information,
# if the user is disabled, kick them out. Now!
commit ab261231b3459a32d04edca2ca3ce892925ded06
Author: Mike Peachey <zordrak at cpan.org>
Date: Tue Jan 20 20:18:14 2009 +0000
RT::Authen::ExternalAuth v0.08_01-alpha6 - Fix for RT-3.8.[0,1] plugin bug re-admitted
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@17840 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/html/Callbacks/ExternalAuth/autohandler/Auth b/html/Callbacks/ExternalAuth/autohandler/Auth
index e1ce79f..54a7fea 100644
--- a/html/Callbacks/ExternalAuth/autohandler/Auth
+++ b/html/Callbacks/ExternalAuth/autohandler/Auth
@@ -1,6 +1,25 @@
+<%once>
+my $loaded_user = 0;
+</%once>
<%init>
+
use RT::Authen::ExternalAuth;
+###################################################################################
+# Work around a bug in the RT 3.8.0 and 3.8.1 plugin system (fixed in 3.8.2) #
+# Temporarily force RT to reload RT::User, since it isn't being loaded #
+# correctly as a plugin. #
+###################################################################################
+unless ($loaded_user) {
+ $RT::Logger->error("Working around bug in RT and reloading RT::User");
+ $loaded_user++;
+ delete $INC{'RT/User.pm'};
+ delete $INC{'RT/User_Overlay.pm'};
+ delete $INC{'RT/User_Vendor.pm'};
+ require RT::User;
+}
+###################################################################################
+
my ($val,$msg);
unless($session{'CurrentUser'} && $session{'CurrentUser'}->Id) {
($val,$msg) = RT::Authen::ExternalAuth::DoAuth(\%session,$user,$pass);
commit bd5b97593951962e6f891f134e55620ec9a27119
Author: Mike Peachey <zordrak at cpan.org>
Date: Tue Jan 20 20:55:09 2009 +0000
RT::Authen::ExternalAuth v0.08_01
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@17841 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/ChangeLog b/ChangeLog
index 1d7a558..0725be1 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,4 +1,4 @@
-v0.08_01 2009-01-18 Mike Peachey <zordrak at cpan.org>
+v0.08_01 2009-01-20 Mike Peachey <zordrak at cpan.org>
* ChangeLog
@@ -17,10 +17,32 @@ v0.08_01 2009-01-18 Mike Peachey <zordrak at cpan.org>
check what type of service was passed and then call the
GetAuth method from the right package.
+ Authentication now halts and returns with error if
+ ExternalAuthPriority is not set. This prevents a fairly
+ useless compile error and logs an explanation instead.
+
+ Information lookup is now bypassed and logged if
+ ExternalInfoPriority is not set, preventing another useless
+ compile error and replacing it with an explanation.
+
SSO Cookie authentication now available following the
integration of RT::Authen::CookieAuth. Methods updated
to reflect the availability of this service.
+ * lib/RT/Authen/ExternalAuth/DBI/Cookie.pm
+
+ File added to house the cookie grab. While SSO cookies are
+ a function of DBI authentication (at the moment at least)
+ there is no need for DBI.pm to use CGI::Cookie for this one
+ purpose. With the future possibility of futher cookie
+ functions as well, I decided it deserved its own module.
+
+ * lib/RT/Authen/ExternalAuth/LDAP.pm
+
+ Changed an unless($base) to unless(defined($base)) to allow
+ for the use of a defined, but empty, baseDN so that an LDAP
+ directory may be searched from the root.
+
* etc/RT_SiteConfig.pm
CookieAuth settings have been merged into the ExternalAuth
diff --git a/README b/README
index 0e613cb..511e453 100644
--- a/README
+++ b/README
@@ -3,13 +3,20 @@ RT-Authen-ExternalAuth
This module provides the ability to authenticate RT users
against one or more external data sources at once. It will
also allow information about that user to be loaded from
-the same, or any other available, source.
+the same, or any other available, source as well as allowing
+multple redundant servers for each method.
The extension currently supports authentication and
information from LDAP via the Net::LDAP module, and from
any data source that an installed DBI driver is available
for.
+It is also possible to use cookies set by an alternate
+application for Single Sign-On (SSO) with that application.
+For example, you may integrate RT with your own website login
+system so that once users log in to your website, they will be
+automagically logged in to RT when they access it.
+
It was originally designed and tested against:
MySQL v4.1.21-standard
@@ -22,9 +29,13 @@ configuration given in your $RTHOME/etc/RT_SiteConfig.pm
As of v0.08 ExternalAuth also allows you to pull a browser
cookie value and test it against a DBI data source allowing
-the use of cookies for Single Sign-On (SSO) authentication.
-This is due to the merging of RT::Authen::ExternalAuth and
-RT::Authen::CookieAuth.
+the use of cookies for Single Sign-On (SSO) authentication
+with another application or website login system. This is
+due to the merging of RT::Authen::ExternalAuth and
+RT::Authen::CookieAuth. For example, you may integrate RT
+with your own website login system so that once users log in
+to your website, they will be automagically logged in to RT
+when they access it.
INSTALLATION
@@ -35,6 +46,10 @@ To install this module, run the following commands:
make
make install
+I recommend:
+RT::Authen::ExternalAuth v0.05 for RT-3.6.x
+RT::Authen::ExternalAuth v0.08+ for RT-3.8.x
+
If you are using RT 3.8.x, you need to enable this
module by adding RT::Authen::ExternalAuth to your
@Plugins configuration:
commit 7ce1198a3f50674771eb8d02c96d8c75a8c1f68a
Author: Mike Peachey <zordrak at cpan.org>
Date: Wed Jan 21 11:47:45 2009 +0000
RT::Authen::ExternalAuth v0.08_02 -- Added ssl_version to the example LDAP configuration.
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@17856 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/etc/RT_SiteConfig.pm b/etc/RT_SiteConfig.pm
index 1700d08..35ebf15 100644
--- a/etc/RT_SiteConfig.pm
+++ b/etc/RT_SiteConfig.pm
@@ -118,6 +118,8 @@ Set($ExternalSettings, { # AN EXAMPLE DB SERVICE
#
# Should we try to use TLS to encrypt connections?
'tls' => 0,
+ # SSL Version to provide to Net::SSLeay *if* using SSL
+ 'ssl_version' => 3,
# What other args should I pass to Net::LDAP->new($host, at args)?
'net_ldap_args' => [ version => 3 ],
# Does authentication depend on group membership? What group name?
commit 0502786b7353f61225903ccdbc9561cd8320c885
Author: Mike Peachey <zordrak at cpan.org>
Date: Wed Jan 21 20:39:55 2009 +0000
RT::Authen::ExternalAuth v0.08_02 -- s/Crypt::MD5::md5_hex/Digest::MD5::md5_hex/
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@17870 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/etc/RT_SiteConfig.pm b/etc/RT_SiteConfig.pm
index 35ebf15..5d6b803 100644
--- a/etc/RT_SiteConfig.pm
+++ b/etc/RT_SiteConfig.pm
@@ -64,7 +64,7 @@ Set($ExternalSettings, { # AN EXAMPLE DB SERVICE
# e.g. if the passwords are stored using the MySQL v3.23 "PASSWORD"
# function, then you will need Crypt::MySQL::password, but for the
# MySQL4+ password function you will need Crypt::MySQL::password41
- # Alternatively, you could use Crypt::MD5::md5_hex or any other
+ # Alternatively, you could use Digest::MD5::md5_hex or any other
# encryption subroutine you can load in your perl installation
'p_enc_pkg' => 'Crypt::MySQL',
'p_enc_sub' => 'password',
commit 08a54013efd78c7926823dbddc3765049b9a8589
Author: Mike Peachey <zordrak at cpan.org>
Date: Wed Jan 21 20:52:21 2009 +0000
RT::Authen::ExternalAuth v0.08_02 -- Added ability to specify salt for DBI password encryption.
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@17871 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/etc/RT_SiteConfig.pm b/etc/RT_SiteConfig.pm
index 5d6b803..b01c5f9 100644
--- a/etc/RT_SiteConfig.pm
+++ b/etc/RT_SiteConfig.pm
@@ -68,6 +68,10 @@ Set($ExternalSettings, { # AN EXAMPLE DB SERVICE
# encryption subroutine you can load in your perl installation
'p_enc_pkg' => 'Crypt::MySQL',
'p_enc_sub' => 'password',
+ # If your p_enc_sub takes a salt as a second parameter,
+ # uncomment this line to add your salt
+ #'p_salt' => 'SALT',
+ #
# The field and values in the table that determines if a user should
# be disabled. For example, if the field is 'user_status' and the values
# are ['0','1','2','disabled'] then the user will be disabled if their
diff --git a/lib/RT/Authen/ExternalAuth/DBI.pm b/lib/RT/Authen/ExternalAuth/DBI.pm
index 0f7726d..a707d5e 100644
--- a/lib/RT/Authen/ExternalAuth/DBI.pm
+++ b/lib/RT/Authen/ExternalAuth/DBI.pm
@@ -17,6 +17,7 @@ sub GetAuth {
my $db_p_field = $config->{'p_field'};
my $db_p_enc_pkg = $config->{'p_enc_pkg'};
my $db_p_enc_sub = $config->{'p_enc_sub'};
+ my $db_p_salt = $config->{'p_salt'};
# Set SQL query and bind parameters
my $query = "SELECT $db_u_field,$db_p_field FROM $db_table WHERE $db_u_field=?";
@@ -74,12 +75,23 @@ sub GetAuth {
# If the package given can perform the subroutine given, then use it to compare the
# password given with the password pulled from the database.
# Jump to the next external authentication service if they don't match
- if(${encrypt}->($password) ne $pass_from_db){
- $RT::Logger->info( $service,
- "AUTH FAILED",
- $username,
- "Password Incorrect");
- return 0;
+ if(defined($db_p_salt)) {
+ $RT::Logger->debug("Using salt:",$db_p_salt);
+ if(${encrypt}->($password,$db_p_salt) ne $pass_from_db){
+ $RT::Logger->info( $service,
+ "AUTH FAILED",
+ $username,
+ "Password Incorrect");
+ return 0;
+ }
+ } else {
+ if(${encrypt}->($password) ne $pass_from_db){
+ $RT::Logger->info( $service,
+ "AUTH FAILED",
+ $username,
+ "Password Incorrect");
+ return 0;
+ }
}
} else {
# If the encryption package can't perform the request subroutine,
commit e6d4f07cefa23a7524adde4c17b65594f9a0acd3
Author: Mike Peachey <zordrak at cpan.org>
Date: Wed Jan 21 21:27:27 2009 +0000
RT::Authen::ExternalAuth v0.08_02 -- Replaced userSupportAccess with more generic "disabled" in DBI example config
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@17872 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/etc/RT_SiteConfig.pm b/etc/RT_SiteConfig.pm
index b01c5f9..4c38a5d 100644
--- a/etc/RT_SiteConfig.pm
+++ b/etc/RT_SiteConfig.pm
@@ -77,7 +77,7 @@ Set($ExternalSettings, { # AN EXAMPLE DB SERVICE
# are ['0','1','2','disabled'] then the user will be disabled if their
# user_status is set to '0','1','2' or the string 'disabled'.
# Otherwise, they will be considered enabled.
- 'd_field' => 'userSupportAccess',
+ 'd_field' => 'disabled',
'd_values' => ['0'],
## RT ATTRIBUTE MATCHING SECTION
# The list of RT attributes that uniquely identify a user
commit dc49b39f07c049a56af575728bd9f8fa8d2ea38e
Author: Mike Peachey <zordrak at cpan.org>
Date: Thu Jan 22 13:23:01 2009 +0000
RT::Authen::ExternalAuth v0.08_02 -- Modified log message for plugin bug in Auth callback. error->debug and change to text.
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@17890 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/html/Callbacks/ExternalAuth/autohandler/Auth b/html/Callbacks/ExternalAuth/autohandler/Auth
index 54a7fea..e188be4 100644
--- a/html/Callbacks/ExternalAuth/autohandler/Auth
+++ b/html/Callbacks/ExternalAuth/autohandler/Auth
@@ -11,7 +11,7 @@ use RT::Authen::ExternalAuth;
# correctly as a plugin. #
###################################################################################
unless ($loaded_user) {
- $RT::Logger->error("Working around bug in RT and reloading RT::User");
+ $RT::Logger->debug("Reloading RT::User to work around a bug in RT-3.8.0 and RT-3.8.1");
$loaded_user++;
delete $INC{'RT/User.pm'};
delete $INC{'RT/User_Overlay.pm'};
commit 0a36b3ba732bb5b3bb97ccaae4393be3baf392d5
Author: Mike Peachey <zordrak at cpan.org>
Date: Sat Jan 24 13:49:33 2009 +0000
RT::Authen::ExternalAuth v0.08
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@17902 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/ChangeLog b/ChangeLog
index 0725be1..183d94b 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,34 @@
+v0.08 2009-01-24 Mike Peachey <zordrak at cpan.org>
+
+ * lib/RT/Authen/ExternalAuth.pm
+
+ Version updated to 0.08
+
+ * ChangeLog
+
+ Added entry for v0.08
+
+ * etc/RT_SiteConfig.pm
+
+ Added ssl_version to example LDAP config as it is used by
+ the code, but had not been demonstrated.
+
+ s/Crypt::MD5::md5_hex/Digest::MD5::md5_hex/ in example DBI
+ config.
+
+ Added the ability to provide a static salt to the p_enc_sub
+ however this behavious may be reviewed in future releases
+ to allow integration with better encryption methods.
+
+ s/userSupportAccess/disabled/ in example DBI config.
+
+ * html/Callbacks/ExternalAuth/autohandler/Auth
+
+ Modified the log message regarding the RT-3.8.[01] plugin
+ bug from error level to debug level and modified the text
+ of the message to be more clear for RT-3.8.2+ users.
+
+
v0.08_01 2009-01-20 Mike Peachey <zordrak at cpan.org>
* ChangeLog
diff --git a/lib/RT/Authen/ExternalAuth.pm b/lib/RT/Authen/ExternalAuth.pm
index be5fa08..55dc8ad 100644
--- a/lib/RT/Authen/ExternalAuth.pm
+++ b/lib/RT/Authen/ExternalAuth.pm
@@ -1,6 +1,6 @@
package RT::Authen::ExternalAuth;
-our $VERSION = '0.08_01';
+our $VERSION = '0.08';
=head1 NAME
commit a5c0c7335b3ad8ae6e96b9a968e6872b5400819a
Author: Mike Peachey <zordrak at cpan.org>
Date: Sat Mar 28 20:07:43 2009 +0000
RT::Authen::ExternalAuth v0.09_01 -- New devel version started. For the moment, just fixing CPAN installs.
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@18973 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/ChangeLog b/ChangeLog
index 183d94b..85f8353 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,16 @@
+v0.09_01 2009-03-28 Mike Peachey <zordrak at cpan.org>
+
+ * Makefile.PL
+
+ Removed RT requirement since most RT installs are not done
+ via CPAN and therefore CPAN installation fails dependency
+ checking.
+
+ * ChangeLog
+
+ Added entry for v0.09_01
+
+
v0.08 2009-01-24 Mike Peachey <zordrak at cpan.org>
* lib/RT/Authen/ExternalAuth.pm
diff --git a/Makefile.PL b/Makefile.PL
index 2ad8ebf..0b3f65e 100755
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -7,8 +7,6 @@ author('Mike Peachey <zordrak at cpan.org>');
all_from('lib/RT/Authen/ExternalAuth.pm');
-requires('RT');
-
features(
'SSL LDAP Connections' => [
-default => 0,
commit 08dd7e9d222b220e8174f97f4ad1001a4f82e7cf
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Fri Apr 24 18:02:51 2009 +0000
Fix example RT_SiteConfig.pm path in README
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@19344 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/README b/README
index 511e453..79031b0 100644
--- a/README
+++ b/README
@@ -59,7 +59,7 @@ Set( @Plugins, qw(RT::Authen::ExternalAuth) );
Once installed, you should view the file:
3.4/3.6 $RTHOME/local/etc/ExternalAuth/RT_SiteConfig.pm
-3.8 $RTHOME/local/plugins/RT-Auth-ExternalAuth/etc/RT_SiteConfig.pm
+3.8 $RTHOME/local/plugins/RT-Authen-ExternalAuth/etc/RT_SiteConfig.pm
Then use the examples provided to prepare your own custom
configuration which should be added to your site configuration in
commit a5d811b79fab2e7f9a23402d322a471862f05d82
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Wed Jun 10 20:36:19 2009 +0000
upgrade M::I
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@19967 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/inc/Module/AutoInstall.pm b/inc/Module/AutoInstall.pm
new file mode 100644
index 0000000..dfb8ef7
--- /dev/null
+++ b/inc/Module/AutoInstall.pm
@@ -0,0 +1,805 @@
+#line 1
+package Module::AutoInstall;
+
+use strict;
+use Cwd ();
+use ExtUtils::MakeMaker ();
+
+use vars qw{$VERSION};
+BEGIN {
+ $VERSION = '1.03';
+}
+
+# special map on pre-defined feature sets
+my %FeatureMap = (
+ '' => 'Core Features', # XXX: deprecated
+ '-core' => 'Core Features',
+);
+
+# various lexical flags
+my ( @Missing, @Existing, %DisabledTests, $UnderCPAN, $HasCPANPLUS );
+my (
+ $Config, $CheckOnly, $SkipInstall, $AcceptDefault, $TestOnly, $AllDeps
+);
+my ( $PostambleActions, $PostambleUsed );
+
+# See if it's a testing or non-interactive session
+_accept_default( $ENV{AUTOMATED_TESTING} or ! -t STDIN );
+_init();
+
+sub _accept_default {
+ $AcceptDefault = shift;
+}
+
+sub missing_modules {
+ return @Missing;
+}
+
+sub do_install {
+ __PACKAGE__->install(
+ [
+ $Config
+ ? ( UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
+ : ()
+ ],
+ @Missing,
+ );
+}
+
+# initialize various flags, and/or perform install
+sub _init {
+ foreach my $arg (
+ @ARGV,
+ split(
+ /[\s\t]+/,
+ $ENV{PERL_AUTOINSTALL} || $ENV{PERL_EXTUTILS_AUTOINSTALL} || ''
+ )
+ )
+ {
+ if ( $arg =~ /^--config=(.*)$/ ) {
+ $Config = [ split( ',', $1 ) ];
+ }
+ elsif ( $arg =~ /^--installdeps=(.*)$/ ) {
+ __PACKAGE__->install( $Config, @Missing = split( /,/, $1 ) );
+ exit 0;
+ }
+ elsif ( $arg =~ /^--default(?:deps)?$/ ) {
+ $AcceptDefault = 1;
+ }
+ elsif ( $arg =~ /^--check(?:deps)?$/ ) {
+ $CheckOnly = 1;
+ }
+ elsif ( $arg =~ /^--skip(?:deps)?$/ ) {
+ $SkipInstall = 1;
+ }
+ elsif ( $arg =~ /^--test(?:only)?$/ ) {
+ $TestOnly = 1;
+ }
+ elsif ( $arg =~ /^--all(?:deps)?$/ ) {
+ $AllDeps = 1;
+ }
+ }
+}
+
+# overrides MakeMaker's prompt() to automatically accept the default choice
+sub _prompt {
+ goto &ExtUtils::MakeMaker::prompt unless $AcceptDefault;
+
+ my ( $prompt, $default ) = @_;
+ my $y = ( $default =~ /^[Yy]/ );
+
+ print $prompt, ' [', ( $y ? 'Y' : 'y' ), '/', ( $y ? 'n' : 'N' ), '] ';
+ print "$default\n";
+ return $default;
+}
+
+# the workhorse
+sub import {
+ my $class = shift;
+ my @args = @_ or return;
+ my $core_all;
+
+ print "*** $class version " . $class->VERSION . "\n";
+ print "*** Checking for Perl dependencies...\n";
+
+ my $cwd = Cwd::cwd();
+
+ $Config = [];
+
+ my $maxlen = length(
+ (
+ sort { length($b) <=> length($a) }
+ grep { /^[^\-]/ }
+ map {
+ ref($_)
+ ? ( ( ref($_) eq 'HASH' ) ? keys(%$_) : @{$_} )
+ : ''
+ }
+ map { +{@args}->{$_} }
+ grep { /^[^\-]/ or /^-core$/i } keys %{ +{@args} }
+ )[0]
+ );
+
+ # We want to know if we're under CPAN early to avoid prompting, but
+ # if we aren't going to try and install anything anyway then skip the
+ # check entirely since we don't want to have to load (and configure)
+ # an old CPAN just for a cosmetic message
+
+ $UnderCPAN = _check_lock(1) unless $SkipInstall;
+
+ while ( my ( $feature, $modules ) = splice( @args, 0, 2 ) ) {
+ my ( @required, @tests, @skiptests );
+ my $default = 1;
+ my $conflict = 0;
+
+ if ( $feature =~ m/^-(\w+)$/ ) {
+ my $option = lc($1);
+
+ # check for a newer version of myself
+ _update_to( $modules, @_ ) and return if $option eq 'version';
+
+ # sets CPAN configuration options
+ $Config = $modules if $option eq 'config';
+
+ # promote every features to core status
+ $core_all = ( $modules =~ /^all$/i ) and next
+ if $option eq 'core';
+
+ next unless $option eq 'core';
+ }
+
+ print "[" . ( $FeatureMap{ lc($feature) } || $feature ) . "]\n";
+
+ $modules = [ %{$modules} ] if UNIVERSAL::isa( $modules, 'HASH' );
+
+ unshift @$modules, -default => &{ shift(@$modules) }
+ if ( ref( $modules->[0] ) eq 'CODE' ); # XXX: bugward combatability
+
+ while ( my ( $mod, $arg ) = splice( @$modules, 0, 2 ) ) {
+ if ( $mod =~ m/^-(\w+)$/ ) {
+ my $option = lc($1);
+
+ $default = $arg if ( $option eq 'default' );
+ $conflict = $arg if ( $option eq 'conflict' );
+ @tests = @{$arg} if ( $option eq 'tests' );
+ @skiptests = @{$arg} if ( $option eq 'skiptests' );
+
+ next;
+ }
+
+ printf( "- %-${maxlen}s ...", $mod );
+
+ if ( $arg and $arg =~ /^\D/ ) {
+ unshift @$modules, $arg;
+ $arg = 0;
+ }
+
+ # XXX: check for conflicts and uninstalls(!) them.
+ my $cur = _load($mod);
+ if (_version_cmp ($cur, $arg) >= 0)
+ {
+ print "loaded. ($cur" . ( $arg ? " >= $arg" : '' ) . ")\n";
+ push @Existing, $mod => $arg;
+ $DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
+ }
+ else {
+ if (not defined $cur) # indeed missing
+ {
+ print "missing." . ( $arg ? " (would need $arg)" : '' ) . "\n";
+ }
+ else
+ {
+ # no need to check $arg as _version_cmp ($cur, undef) would satisfy >= above
+ print "too old. ($cur < $arg)\n";
+ }
+
+ push @required, $mod => $arg;
+ }
+ }
+
+ next unless @required;
+
+ my $mandatory = ( $feature eq '-core' or $core_all );
+
+ if (
+ !$SkipInstall
+ and (
+ $CheckOnly
+ or ($mandatory and $UnderCPAN)
+ or $AllDeps
+ or _prompt(
+ qq{==> Auto-install the }
+ . ( @required / 2 )
+ . ( $mandatory ? ' mandatory' : ' optional' )
+ . qq{ module(s) from CPAN?},
+ $default ? 'y' : 'n',
+ ) =~ /^[Yy]/
+ )
+ )
+ {
+ push( @Missing, @required );
+ $DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
+ }
+
+ elsif ( !$SkipInstall
+ and $default
+ and $mandatory
+ and
+ _prompt( qq{==> The module(s) are mandatory! Really skip?}, 'n', )
+ =~ /^[Nn]/ )
+ {
+ push( @Missing, @required );
+ $DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
+ }
+
+ else {
+ $DisabledTests{$_} = 1 for map { glob($_) } @tests;
+ }
+ }
+
+ if ( @Missing and not( $CheckOnly or $UnderCPAN ) ) {
+ require Config;
+ print
+"*** Dependencies will be installed the next time you type '$Config::Config{make}'.\n";
+
+ # make an educated guess of whether we'll need root permission.
+ print " (You may need to do that as the 'root' user.)\n"
+ if eval '$>';
+ }
+ print "*** $class configuration finished.\n";
+
+ chdir $cwd;
+
+ # import to main::
+ no strict 'refs';
+ *{'main::WriteMakefile'} = \&Write if caller(0) eq 'main';
+}
+
+sub _running_under {
+ my $thing = shift;
+ print <<"END_MESSAGE";
+*** Since we're running under ${thing}, I'll just let it take care
+ of the dependency's installation later.
+END_MESSAGE
+ return 1;
+}
+
+# Check to see if we are currently running under CPAN.pm and/or CPANPLUS;
+# if we are, then we simply let it taking care of our dependencies
+sub _check_lock {
+ return unless @Missing or @_;
+
+ my $cpan_env = $ENV{PERL5_CPAN_IS_RUNNING};
+
+ if ($ENV{PERL5_CPANPLUS_IS_RUNNING}) {
+ return _running_under($cpan_env ? 'CPAN' : 'CPANPLUS');
+ }
+
+ require CPAN;
+
+ if ($CPAN::VERSION > '1.89') {
+ if ($cpan_env) {
+ return _running_under('CPAN');
+ }
+ return; # CPAN.pm new enough, don't need to check further
+ }
+
+ # last ditch attempt, this -will- configure CPAN, very sorry
+
+ _load_cpan(1); # force initialize even though it's already loaded
+
+ # Find the CPAN lock-file
+ my $lock = MM->catfile( $CPAN::Config->{cpan_home}, ".lock" );
+ return unless -f $lock;
+
+ # Check the lock
+ local *LOCK;
+ return unless open(LOCK, $lock);
+
+ if (
+ ( $^O eq 'MSWin32' ? _under_cpan() : <LOCK> == getppid() )
+ and ( $CPAN::Config->{prerequisites_policy} || '' ) ne 'ignore'
+ ) {
+ print <<'END_MESSAGE';
+
+*** Since we're running under CPAN, I'll just let it take care
+ of the dependency's installation later.
+END_MESSAGE
+ return 1;
+ }
+
+ close LOCK;
+ return;
+}
+
+sub install {
+ my $class = shift;
+
+ my $i; # used below to strip leading '-' from config keys
+ my @config = ( map { s/^-// if ++$i; $_ } @{ +shift } );
+
+ my ( @modules, @installed );
+ while ( my ( $pkg, $ver ) = splice( @_, 0, 2 ) ) {
+
+ # grep out those already installed
+ if ( _version_cmp( _load($pkg), $ver ) >= 0 ) {
+ push @installed, $pkg;
+ }
+ else {
+ push @modules, $pkg, $ver;
+ }
+ }
+
+ return @installed unless @modules; # nothing to do
+ return @installed if _check_lock(); # defer to the CPAN shell
+
+ print "*** Installing dependencies...\n";
+
+ return unless _connected_to('cpan.org');
+
+ my %args = @config;
+ my %failed;
+ local *FAILED;
+ if ( $args{do_once} and open( FAILED, '.#autoinstall.failed' ) ) {
+ while (<FAILED>) { chomp; $failed{$_}++ }
+ close FAILED;
+
+ my @newmod;
+ while ( my ( $k, $v ) = splice( @modules, 0, 2 ) ) {
+ push @newmod, ( $k => $v ) unless $failed{$k};
+ }
+ @modules = @newmod;
+ }
+
+ if ( _has_cpanplus() and not $ENV{PERL_AUTOINSTALL_PREFER_CPAN} ) {
+ _install_cpanplus( \@modules, \@config );
+ } else {
+ _install_cpan( \@modules, \@config );
+ }
+
+ print "*** $class installation finished.\n";
+
+ # see if we have successfully installed them
+ while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
+ if ( _version_cmp( _load($pkg), $ver ) >= 0 ) {
+ push @installed, $pkg;
+ }
+ elsif ( $args{do_once} and open( FAILED, '>> .#autoinstall.failed' ) ) {
+ print FAILED "$pkg\n";
+ }
+ }
+
+ close FAILED if $args{do_once};
+
+ return @installed;
+}
+
+sub _install_cpanplus {
+ my @modules = @{ +shift };
+ my @config = _cpanplus_config( @{ +shift } );
+ my $installed = 0;
+
+ require CPANPLUS::Backend;
+ my $cp = CPANPLUS::Backend->new;
+ my $conf = $cp->configure_object;
+
+ return unless $conf->can('conf') # 0.05x+ with "sudo" support
+ or _can_write($conf->_get_build('base')); # 0.04x
+
+ # if we're root, set UNINST=1 to avoid trouble unless user asked for it.
+ my $makeflags = $conf->get_conf('makeflags') || '';
+ if ( UNIVERSAL::isa( $makeflags, 'HASH' ) ) {
+ # 0.03+ uses a hashref here
+ $makeflags->{UNINST} = 1 unless exists $makeflags->{UNINST};
+
+ } else {
+ # 0.02 and below uses a scalar
+ $makeflags = join( ' ', split( ' ', $makeflags ), 'UNINST=1' )
+ if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } );
+
+ }
+ $conf->set_conf( makeflags => $makeflags );
+ $conf->set_conf( prereqs => 1 );
+
+
+
+ while ( my ( $key, $val ) = splice( @config, 0, 2 ) ) {
+ $conf->set_conf( $key, $val );
+ }
+
+ my $modtree = $cp->module_tree;
+ while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
+ print "*** Installing $pkg...\n";
+
+ MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall;
+
+ my $success;
+ my $obj = $modtree->{$pkg};
+
+ if ( $obj and _version_cmp( $obj->{version}, $ver ) >= 0 ) {
+ my $pathname = $pkg;
+ $pathname =~ s/::/\\W/;
+
+ foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) {
+ delete $INC{$inc};
+ }
+
+ my $rv = $cp->install( modules => [ $obj->{module} ] );
+
+ if ( $rv and ( $rv->{ $obj->{module} } or $rv->{ok} ) ) {
+ print "*** $pkg successfully installed.\n";
+ $success = 1;
+ } else {
+ print "*** $pkg installation cancelled.\n";
+ $success = 0;
+ }
+
+ $installed += $success;
+ } else {
+ print << ".";
+*** Could not find a version $ver or above for $pkg; skipping.
+.
+ }
+
+ MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall;
+ }
+
+ return $installed;
+}
+
+sub _cpanplus_config {
+ my @config = ();
+ while ( @_ ) {
+ my ($key, $value) = (shift(), shift());
+ if ( $key eq 'prerequisites_policy' ) {
+ if ( $value eq 'follow' ) {
+ $value = CPANPLUS::Internals::Constants::PREREQ_INSTALL();
+ } elsif ( $value eq 'ask' ) {
+ $value = CPANPLUS::Internals::Constants::PREREQ_ASK();
+ } elsif ( $value eq 'ignore' ) {
+ $value = CPANPLUS::Internals::Constants::PREREQ_IGNORE();
+ } else {
+ die "*** Cannot convert option $key = '$value' to CPANPLUS version.\n";
+ }
+ } else {
+ die "*** Cannot convert option $key to CPANPLUS version.\n";
+ }
+ }
+ return @config;
+}
+
+sub _install_cpan {
+ my @modules = @{ +shift };
+ my @config = @{ +shift };
+ my $installed = 0;
+ my %args;
+
+ _load_cpan();
+ require Config;
+
+ if (CPAN->VERSION < 1.80) {
+ # no "sudo" support, probe for writableness
+ return unless _can_write( MM->catfile( $CPAN::Config->{cpan_home}, 'sources' ) )
+ and _can_write( $Config::Config{sitelib} );
+ }
+
+ # if we're root, set UNINST=1 to avoid trouble unless user asked for it.
+ my $makeflags = $CPAN::Config->{make_install_arg} || '';
+ $CPAN::Config->{make_install_arg} =
+ join( ' ', split( ' ', $makeflags ), 'UNINST=1' )
+ if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } );
+
+ # don't show start-up info
+ $CPAN::Config->{inhibit_startup_message} = 1;
+
+ # set additional options
+ while ( my ( $opt, $arg ) = splice( @config, 0, 2 ) ) {
+ ( $args{$opt} = $arg, next )
+ if $opt =~ /^force$/; # pseudo-option
+ $CPAN::Config->{$opt} = $arg;
+ }
+
+ local $CPAN::Config->{prerequisites_policy} = 'follow';
+
+ while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
+ MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall;
+
+ print "*** Installing $pkg...\n";
+
+ my $obj = CPAN::Shell->expand( Module => $pkg );
+ my $success = 0;
+
+ if ( $obj and _version_cmp( $obj->cpan_version, $ver ) >= 0 ) {
+ my $pathname = $pkg;
+ $pathname =~ s/::/\\W/;
+
+ foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) {
+ delete $INC{$inc};
+ }
+
+ my $rv = $args{force} ? CPAN::Shell->force( install => $pkg )
+ : CPAN::Shell->install($pkg);
+ $rv ||= eval {
+ $CPAN::META->instance( 'CPAN::Distribution', $obj->cpan_file, )
+ ->{install}
+ if $CPAN::META;
+ };
+
+ if ( $rv eq 'YES' ) {
+ print "*** $pkg successfully installed.\n";
+ $success = 1;
+ }
+ else {
+ print "*** $pkg installation failed.\n";
+ $success = 0;
+ }
+
+ $installed += $success;
+ }
+ else {
+ print << ".";
+*** Could not find a version $ver or above for $pkg; skipping.
+.
+ }
+
+ MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall;
+ }
+
+ return $installed;
+}
+
+sub _has_cpanplus {
+ return (
+ $HasCPANPLUS = (
+ $INC{'CPANPLUS/Config.pm'}
+ or _load('CPANPLUS::Shell::Default')
+ )
+ );
+}
+
+# make guesses on whether we're under the CPAN installation directory
+sub _under_cpan {
+ require Cwd;
+ require File::Spec;
+
+ my $cwd = File::Spec->canonpath( Cwd::cwd() );
+ my $cpan = File::Spec->canonpath( $CPAN::Config->{cpan_home} );
+
+ return ( index( $cwd, $cpan ) > -1 );
+}
+
+sub _update_to {
+ my $class = __PACKAGE__;
+ my $ver = shift;
+
+ return
+ if _version_cmp( _load($class), $ver ) >= 0; # no need to upgrade
+
+ if (
+ _prompt( "==> A newer version of $class ($ver) is required. Install?",
+ 'y' ) =~ /^[Nn]/
+ )
+ {
+ die "*** Please install $class $ver manually.\n";
+ }
+
+ print << ".";
+*** Trying to fetch it from CPAN...
+.
+
+ # install ourselves
+ _load($class) and return $class->import(@_)
+ if $class->install( [], $class, $ver );
+
+ print << '.'; exit 1;
+
+*** Cannot bootstrap myself. :-( Installation terminated.
+.
+}
+
+# check if we're connected to some host, using inet_aton
+sub _connected_to {
+ my $site = shift;
+
+ return (
+ ( _load('Socket') and Socket::inet_aton($site) ) or _prompt(
+ qq(
+*** Your host cannot resolve the domain name '$site', which
+ probably means the Internet connections are unavailable.
+==> Should we try to install the required module(s) anyway?), 'n'
+ ) =~ /^[Yy]/
+ );
+}
+
+# check if a directory is writable; may create it on demand
+sub _can_write {
+ my $path = shift;
+ mkdir( $path, 0755 ) unless -e $path;
+
+ return 1 if -w $path;
+
+ print << ".";
+*** You are not allowed to write to the directory '$path';
+ the installation may fail due to insufficient permissions.
+.
+
+ if (
+ eval '$>' and lc(`sudo -V`) =~ /version/ and _prompt(
+ qq(
+==> Should we try to re-execute the autoinstall process with 'sudo'?),
+ ((-t STDIN) ? 'y' : 'n')
+ ) =~ /^[Yy]/
+ )
+ {
+
+ # try to bootstrap ourselves from sudo
+ print << ".";
+*** Trying to re-execute the autoinstall process with 'sudo'...
+.
+ my $missing = join( ',', @Missing );
+ my $config = join( ',',
+ UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
+ if $Config;
+
+ return
+ unless system( 'sudo', $^X, $0, "--config=$config",
+ "--installdeps=$missing" );
+
+ print << ".";
+*** The 'sudo' command exited with error! Resuming...
+.
+ }
+
+ return _prompt(
+ qq(
+==> Should we try to install the required module(s) anyway?), 'n'
+ ) =~ /^[Yy]/;
+}
+
+# load a module and return the version it reports
+sub _load {
+ my $mod = pop; # class/instance doesn't matter
+ my $file = $mod;
+
+ $file =~ s|::|/|g;
+ $file .= '.pm';
+
+ local $@;
+ return eval { require $file; $mod->VERSION } || ( $@ ? undef: 0 );
+}
+
+# Load CPAN.pm and it's configuration
+sub _load_cpan {
+ return if $CPAN::VERSION and $CPAN::Config and not @_;
+ require CPAN;
+ if ( $CPAN::HandleConfig::VERSION ) {
+ # Newer versions of CPAN have a HandleConfig module
+ CPAN::HandleConfig->load;
+ } else {
+ # Older versions had the load method in Config directly
+ CPAN::Config->load;
+ }
+}
+
+# compare two versions, either use Sort::Versions or plain comparison
+# return values same as <=>
+sub _version_cmp {
+ my ( $cur, $min ) = @_;
+ return -1 unless defined $cur; # if 0 keep comparing
+ return 1 unless $min;
+
+ $cur =~ s/\s+$//;
+
+ # check for version numbers that are not in decimal format
+ if ( ref($cur) or ref($min) or $cur =~ /v|\..*\./ or $min =~ /v|\..*\./ ) {
+ if ( ( $version::VERSION or defined( _load('version') )) and
+ version->can('new')
+ ) {
+
+ # use version.pm if it is installed.
+ return version->new($cur) <=> version->new($min);
+ }
+ elsif ( $Sort::Versions::VERSION or defined( _load('Sort::Versions') ) )
+ {
+
+ # use Sort::Versions as the sorting algorithm for a.b.c versions
+ return Sort::Versions::versioncmp( $cur, $min );
+ }
+
+ warn "Cannot reliably compare non-decimal formatted versions.\n"
+ . "Please install version.pm or Sort::Versions.\n";
+ }
+
+ # plain comparison
+ local $^W = 0; # shuts off 'not numeric' bugs
+ return $cur <=> $min;
+}
+
+# nothing; this usage is deprecated.
+sub main::PREREQ_PM { return {}; }
+
+sub _make_args {
+ my %args = @_;
+
+ $args{PREREQ_PM} = { %{ $args{PREREQ_PM} || {} }, @Existing, @Missing }
+ if $UnderCPAN or $TestOnly;
+
+ if ( $args{EXE_FILES} and -e 'MANIFEST' ) {
+ require ExtUtils::Manifest;
+ my $manifest = ExtUtils::Manifest::maniread('MANIFEST');
+
+ $args{EXE_FILES} =
+ [ grep { exists $manifest->{$_} } @{ $args{EXE_FILES} } ];
+ }
+
+ $args{test}{TESTS} ||= 't/*.t';
+ $args{test}{TESTS} = join( ' ',
+ grep { !exists( $DisabledTests{$_} ) }
+ map { glob($_) } split( /\s+/, $args{test}{TESTS} ) );
+
+ my $missing = join( ',', @Missing );
+ my $config =
+ join( ',', UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
+ if $Config;
+
+ $PostambleActions = (
+ ($missing and not $UnderCPAN)
+ ? "\$(PERL) $0 --config=$config --installdeps=$missing"
+ : "\$(NOECHO) \$(NOOP)"
+ );
+
+ return %args;
+}
+
+# a wrapper to ExtUtils::MakeMaker::WriteMakefile
+sub Write {
+ require Carp;
+ Carp::croak "WriteMakefile: Need even number of args" if @_ % 2;
+
+ if ($CheckOnly) {
+ print << ".";
+*** Makefile not written in check-only mode.
+.
+ return;
+ }
+
+ my %args = _make_args(@_);
+
+ no strict 'refs';
+
+ $PostambleUsed = 0;
+ local *MY::postamble = \&postamble unless defined &MY::postamble;
+ ExtUtils::MakeMaker::WriteMakefile(%args);
+
+ print << "." unless $PostambleUsed;
+*** WARNING: Makefile written with customized MY::postamble() without
+ including contents from Module::AutoInstall::postamble() --
+ auto installation features disabled. Please contact the author.
+.
+
+ return 1;
+}
+
+sub postamble {
+ $PostambleUsed = 1;
+
+ return <<"END_MAKE";
+
+config :: installdeps
+\t\$(NOECHO) \$(NOOP)
+
+checkdeps ::
+\t\$(PERL) $0 --checkdeps
+
+installdeps ::
+\t$PostambleActions
+
+END_MAKE
+
+}
+
+1;
+
+__END__
+
+#line 1056
diff --git a/inc/Module/Install.pm b/inc/Module/Install.pm
index e6758c9..51eda5d 100644
--- a/inc/Module/Install.pm
+++ b/inc/Module/Install.pm
@@ -17,12 +17,10 @@ package Module::Install;
# 3. The ./inc/ version of Module::Install loads
# }
-BEGIN {
- require 5.004;
-}
+use 5.005;
use strict 'vars';
-use vars qw{$VERSION};
+use vars qw{$VERSION $MAIN};
BEGIN {
# All Module::Install core packages now require synchronised versions.
# This will be used to ensure we don't accidentally load old or
@@ -30,7 +28,14 @@ BEGIN {
# This is not enforced yet, but will be some time in the next few
# releases once we can make sure it won't clash with custom
# Module::Install extensions.
- $VERSION = '0.70';
+ $VERSION = '0.91';
+
+ # Storage for the pseudo-singleton
+ $MAIN = undef;
+
+ *inc::Module::Install::VERSION = *VERSION;
+ @inc::Module::Install::ISA = __PACKAGE__;
+
}
@@ -65,15 +70,26 @@ END_DIE
# again. This is bad. Rather than taking action to touch it (which
# is unreliable on some platforms and requires write permissions)
# for now we should catch this and refuse to run.
-if ( -f $0 and (stat($0))[9] > time ) { die <<"END_DIE" }
+if ( -f $0 ) {
+ my $s = (stat($0))[9];
+
+ # If the modification time is only slightly in the future,
+ # sleep briefly to remove the problem.
+ my $a = $s - time;
+ if ( $a > 0 and $a < 5 ) { sleep 5 }
-Your installer $0 has a modification time in the future.
+ # Too far in the future, throw an error.
+ my $t = time;
+ if ( $s > $t ) { die <<"END_DIE" }
+
+Your installer $0 has a modification time in the future ($s > $t).
This is known to create infinite loops in make.
Please correct this, then run $0 again.
END_DIE
+}
@@ -81,7 +97,7 @@ END_DIE
# Build.PL was formerly supported, but no longer is due to excessive
# difficulty in implementing every single feature twice.
-if ( $0 =~ /Build.PL$/i or -f 'Build.PL' ) { die <<"END_DIE" }
+if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" }
Module::Install no longer supports Build.PL.
@@ -95,14 +111,20 @@ END_DIE
+# To save some more typing in Module::Install installers, every...
+# use inc::Module::Install
+# ...also acts as an implicit use strict.
+$^H |= strict::bits(qw(refs subs vars));
+
+
+
+
+
use Cwd ();
use File::Find ();
use File::Path ();
use FindBin;
-*inc::Module::Install::VERSION = *VERSION;
- at inc::Module::Install::ISA = __PACKAGE__;
-
sub autoload {
my $self = shift;
my $who = $self->_caller;
@@ -111,12 +133,22 @@ sub autoload {
$sym->{$cwd} = sub {
my $pwd = Cwd::cwd();
if ( my $code = $sym->{$pwd} ) {
- # delegate back to parent dirs
+ # Delegate back to parent dirs
goto &$code unless $cwd eq $pwd;
}
$$sym =~ /([^:]+)$/ or die "Cannot autoload $who - $sym";
+ my $method = $1;
+ if ( uc($method) eq $method ) {
+ # Do nothing
+ return;
+ } elsif ( $method =~ /^_/ and $self->can($method) ) {
+ # Dispatch to the root M:I class
+ return $self->$method(@_);
+ }
+
+ # Dispatch to the appropriate plugin
unshift @_, ( $self, $1 );
- goto &{$self->can('call')} unless uc($1) eq $1;
+ goto &{$self->can('call')};
};
}
@@ -141,12 +173,14 @@ sub import {
delete $INC{"$self->{file}"};
delete $INC{"$self->{path}.pm"};
+ # Save to the singleton
+ $MAIN = $self;
+
return 1;
}
sub preload {
- my ($self) = @_;
-
+ my $self = shift;
unless ( $self->{extensions} ) {
$self->load_extensions(
"$self->{prefix}/$self->{path}", $self
@@ -155,8 +189,7 @@ sub preload {
my @exts = @{$self->{extensions}};
unless ( @exts ) {
- my $admin = $self->{admin};
- @exts = $admin->load_all_extensions;
+ @exts = $self->{admin}->load_all_extensions;
}
my %seen;
@@ -202,6 +235,7 @@ sub new {
$args{path} =~ s!::!/!g;
}
$args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm";
+ $args{wrote} = 0;
bless( \%args, $class );
}
@@ -238,7 +272,7 @@ END_DIE
sub load_extensions {
my ($self, $path, $top) = @_;
- unless ( grep { lc $_ eq lc $self->{prefix} } @INC ) {
+ unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) {
unshift @INC, $self->{prefix};
}
@@ -277,9 +311,9 @@ sub find_extensions {
# correctly. Otherwise, root through the file to locate the case-preserved
# version of the package name.
if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) {
- open PKGFILE, "<$subpath.pm" or die "find_extensions: Can't open $subpath.pm: $!";
- my $in_pod = 0;
- while ( <PKGFILE> ) {
+ my $content = Module::Install::_read($subpath . '.pm');
+ my $in_pod = 0;
+ foreach ( split //, $content ) {
$in_pod = 1 if /^=\w/;
$in_pod = 0 if /^=cut/;
next if ($in_pod || /^=cut/); # skip pod text
@@ -289,7 +323,6 @@ sub find_extensions {
last;
}
}
- close PKGFILE;
}
push @found, [ $file, $pkg ];
@@ -298,6 +331,13 @@ sub find_extensions {
@found;
}
+
+
+
+
+#####################################################################
+# Common Utility Functions
+
sub _caller {
my $depth = 0;
my $call = caller($depth);
@@ -308,6 +348,83 @@ sub _caller {
return $call;
}
+sub _read {
+ local *FH;
+ if ( $] >= 5.006 ) {
+ open( FH, '<', $_[0] ) or die "open($_[0]): $!";
+ } else {
+ open( FH, "< $_[0]" ) or die "open($_[0]): $!";
+ }
+ my $string = do { local $/; <FH> };
+ close FH or die "close($_[0]): $!";
+ return $string;
+}
+
+sub _readperl {
+ my $string = Module::Install::_read($_[0]);
+ $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg;
+ $string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s;
+ $string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg;
+ return $string;
+}
+
+sub _readpod {
+ my $string = Module::Install::_read($_[0]);
+ $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg;
+ return $string if $_[0] =~ /\.pod\z/;
+ $string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg;
+ $string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg;
+ $string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg;
+ $string =~ s/^\n+//s;
+ return $string;
+}
+
+sub _write {
+ local *FH;
+ if ( $] >= 5.006 ) {
+ open( FH, '>', $_[0] ) or die "open($_[0]): $!";
+ } else {
+ open( FH, "> $_[0]" ) or die "open($_[0]): $!";
+ }
+ foreach ( 1 .. $#_ ) {
+ print FH $_[$_] or die "print($_[0]): $!";
+ }
+ close FH or die "close($_[0]): $!";
+}
+
+# _version is for processing module versions (eg, 1.03_05) not
+# Perl versions (eg, 5.8.1).
+sub _version ($) {
+ my $s = shift || 0;
+ my $d =()= $s =~ /(\.)/g;
+ if ( $d >= 2 ) {
+ # Normalise multipart versions
+ $s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg;
+ }
+ $s =~ s/^(\d+)\.?//;
+ my $l = $1 || 0;
+ my @v = map {
+ $_ . '0' x (3 - length $_)
+ } $s =~ /(\d{1,3})\D?/g;
+ $l = $l . '.' . join '', @v if @v;
+ return $l + 0;
+}
+
+sub _cmp ($$) {
+ _version($_[0]) <=> _version($_[1]);
+}
+
+# Cloned from Params::Util::_CLASS
+sub _CLASS ($) {
+ (
+ defined $_[0]
+ and
+ ! ref $_[0]
+ and
+ $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s
+ ) ? $_[0] : undef;
+}
+
1;
-# Copyright 2008 Adam Kennedy.
+# Copyright 2008 - 2009 Adam Kennedy.
diff --git a/inc/Module/Install/AutoInstall.pm b/inc/Module/Install/AutoInstall.pm
new file mode 100644
index 0000000..58dd026
--- /dev/null
+++ b/inc/Module/Install/AutoInstall.pm
@@ -0,0 +1,61 @@
+#line 1
+package Module::Install::AutoInstall;
+
+use strict;
+use Module::Install::Base ();
+
+use vars qw{$VERSION @ISA $ISCORE};
+BEGIN {
+ $VERSION = '0.91';
+ @ISA = 'Module::Install::Base';
+ $ISCORE = 1;
+}
+
+sub AutoInstall { $_[0] }
+
+sub run {
+ my $self = shift;
+ $self->auto_install_now(@_);
+}
+
+sub write {
+ my $self = shift;
+ $self->auto_install(@_);
+}
+
+sub auto_install {
+ my $self = shift;
+ return if $self->{done}++;
+
+ # Flatten array of arrays into a single array
+ my @core = map @$_, map @$_, grep ref,
+ $self->build_requires, $self->requires;
+
+ my @config = @_;
+
+ # We'll need Module::AutoInstall
+ $self->include('Module::AutoInstall');
+ require Module::AutoInstall;
+
+ Module::AutoInstall->import(
+ (@config ? (-config => \@config) : ()),
+ (@core ? (-core => \@core) : ()),
+ $self->features,
+ );
+
+ $self->makemaker_args( Module::AutoInstall::_make_args() );
+
+ my $class = ref($self);
+ $self->postamble(
+ "# --- $class section:\n" .
+ Module::AutoInstall::postamble()
+ );
+}
+
+sub auto_install_now {
+ my $self = shift;
+ $self->auto_install(@_);
+ Module::AutoInstall::do_install();
+}
+
+1;
diff --git a/inc/Module/Install/Base.pm b/inc/Module/Install/Base.pm
index 5e24ae1..60a74d2 100644
--- a/inc/Module/Install/Base.pm
+++ b/inc/Module/Install/Base.pm
@@ -1,7 +1,11 @@
#line 1
package Module::Install::Base;
-$VERSION = '0.70';
+use strict 'vars';
+use vars qw{$VERSION};
+BEGIN {
+ $VERSION = '0.91';
+}
# Suspend handler for "redefined" warnings
BEGIN {
@@ -9,52 +13,56 @@ BEGIN {
$SIG{__WARN__} = sub { $w };
}
-### This is the ONLY module that shouldn't have strict on
-# use strict;
-
-#line 41
+#line 42
sub new {
- my ($class, %args) = @_;
-
- foreach my $method ( qw(call load) ) {
- *{"$class\::$method"} = sub {
- shift()->_top->$method(@_);
- } unless defined &{"$class\::$method"};
- }
-
- bless( \%args, $class );
+ my $class = shift;
+ unless ( defined &{"${class}::call"} ) {
+ *{"${class}::call"} = sub { shift->_top->call(@_) };
+ }
+ unless ( defined &{"${class}::load"} ) {
+ *{"${class}::load"} = sub { shift->_top->load(@_) };
+ }
+ bless { @_ }, $class;
}
#line 61
sub AUTOLOAD {
- my $self = shift;
- local $@;
- my $autoload = eval { $self->_top->autoload } or return;
- goto &$autoload;
+ local $@;
+ my $func = eval { shift->_top->autoload } or return;
+ goto &$func;
}
-#line 76
+#line 75
-sub _top { $_[0]->{_top} }
+sub _top {
+ $_[0]->{_top};
+}
-#line 89
+#line 90
sub admin {
- $_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new;
+ $_[0]->_top->{admin}
+ or
+ Module::Install::Base::FakeAdmin->new;
}
+#line 106
+
sub is_admin {
- $_[0]->admin->VERSION;
+ $_[0]->admin->VERSION;
}
sub DESTROY {}
package Module::Install::Base::FakeAdmin;
-my $Fake;
-sub new { $Fake ||= bless(\@_, $_[0]) }
+my $fake;
+
+sub new {
+ $fake ||= bless(\@_, $_[0]);
+}
sub AUTOLOAD {}
@@ -67,4 +75,4 @@ BEGIN {
1;
-#line 138
+#line 154
diff --git a/inc/Module/Install/Can.pm b/inc/Module/Install/Can.pm
index 9ce21a4..e65e4f6 100644
--- a/inc/Module/Install/Can.pm
+++ b/inc/Module/Install/Can.pm
@@ -2,18 +2,16 @@
package Module::Install::Can;
use strict;
-use Module::Install::Base;
-use Config ();
-### This adds a 5.005 Perl version dependency.
-### This is a bug and will be fixed.
-use File::Spec ();
-use ExtUtils::MakeMaker ();
-
-use vars qw{$VERSION $ISCORE @ISA};
+use Config ();
+use File::Spec ();
+use ExtUtils::MakeMaker ();
+use Module::Install::Base ();
+
+use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.70';
+ $VERSION = '0.91';
+ @ISA = 'Module::Install::Base';
$ISCORE = 1;
- @ISA = qw{Module::Install::Base};
}
# check if we can load some module
@@ -39,6 +37,7 @@ sub can_run {
return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd));
for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') {
+ next if $dir eq '';
my $abs = File::Spec->catfile($dir, $_[1]);
return $abs if (-x $abs or $abs = MM->maybe_command($abs));
}
@@ -79,4 +78,4 @@ if ( $^O eq 'cygwin' ) {
__END__
-#line 157
+#line 156
diff --git a/inc/Module/Install/Fetch.pm b/inc/Module/Install/Fetch.pm
index 2b8f6e8..05f2079 100644
--- a/inc/Module/Install/Fetch.pm
+++ b/inc/Module/Install/Fetch.pm
@@ -2,24 +2,24 @@
package Module::Install::Fetch;
use strict;
-use Module::Install::Base;
+use Module::Install::Base ();
-use vars qw{$VERSION $ISCORE @ISA};
+use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.70';
+ $VERSION = '0.91';
+ @ISA = 'Module::Install::Base';
$ISCORE = 1;
- @ISA = qw{Module::Install::Base};
}
sub get_file {
my ($self, %args) = @_;
- my ($scheme, $host, $path, $file) =
+ my ($scheme, $host, $path, $file) =
$args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) {
$args{url} = $args{ftp_url}
or (warn("LWP support unavailable!\n"), return);
- ($scheme, $host, $path, $file) =
+ ($scheme, $host, $path, $file) =
$args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
}
diff --git a/inc/Module/Install/Include.pm b/inc/Module/Install/Include.pm
new file mode 100644
index 0000000..7e792e0
--- /dev/null
+++ b/inc/Module/Install/Include.pm
@@ -0,0 +1,34 @@
+#line 1
+package Module::Install::Include;
+
+use strict;
+use Module::Install::Base ();
+
+use vars qw{$VERSION @ISA $ISCORE};
+BEGIN {
+ $VERSION = '0.91';
+ @ISA = 'Module::Install::Base';
+ $ISCORE = 1;
+}
+
+sub include {
+ shift()->admin->include(@_);
+}
+
+sub include_deps {
+ shift()->admin->include_deps(@_);
+}
+
+sub auto_include {
+ shift()->admin->auto_include(@_);
+}
+
+sub auto_include_deps {
+ shift()->admin->auto_include_deps(@_);
+}
+
+sub auto_include_dependent_dists {
+ shift()->admin->auto_include_dependent_dists(@_);
+}
+
+1;
diff --git a/inc/Module/Install/Makefile.pm b/inc/Module/Install/Makefile.pm
index 27bbace..98779db 100644
--- a/inc/Module/Install/Makefile.pm
+++ b/inc/Module/Install/Makefile.pm
@@ -2,14 +2,14 @@
package Module::Install::Makefile;
use strict 'vars';
-use Module::Install::Base;
-use ExtUtils::MakeMaker ();
+use ExtUtils::MakeMaker ();
+use Module::Install::Base ();
-use vars qw{$VERSION $ISCORE @ISA};
+use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.70';
+ $VERSION = '0.91';
+ @ISA = 'Module::Install::Base';
$ISCORE = 1;
- @ISA = qw{Module::Install::Base};
}
sub Makefile { $_[0] }
@@ -36,9 +36,9 @@ sub prompt {
sub makemaker_args {
my $self = shift;
- my $args = ($self->{makemaker_args} ||= {});
- %$args = ( %$args, @_ ) if @_;
- $args;
+ my $args = ( $self->{makemaker_args} ||= {} );
+ %$args = ( %$args, @_ );
+ return $args;
}
# For mm args that take multiple space-seperated args,
@@ -63,18 +63,18 @@ sub build_subdirs {
sub clean_files {
my $self = shift;
my $clean = $self->makemaker_args->{clean} ||= {};
- %$clean = (
- %$clean,
- FILES => join(' ', grep length, $clean->{FILES}, @_),
+ %$clean = (
+ %$clean,
+ FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_),
);
}
sub realclean_files {
- my $self = shift;
+ my $self = shift;
my $realclean = $self->makemaker_args->{realclean} ||= {};
- %$realclean = (
- %$realclean,
- FILES => join(' ', grep length, $realclean->{FILES}, @_),
+ %$realclean = (
+ %$realclean,
+ FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_),
);
}
@@ -114,20 +114,41 @@ sub write {
my $self = shift;
die "&Makefile->write() takes no arguments\n" if @_;
- # Make sure we have a new enough
+ # Check the current Perl version
+ my $perl_version = $self->perl_version;
+ if ( $perl_version ) {
+ eval "use $perl_version; 1"
+ or die "ERROR: perl: Version $] is installed, "
+ . "but we need version >= $perl_version";
+ }
+
+ # Make sure we have a new enough MakeMaker
require ExtUtils::MakeMaker;
- $self->configure_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION );
- # Generate the
+ if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) {
+ # MakeMaker can complain about module versions that include
+ # an underscore, even though its own version may contain one!
+ # Hence the funny regexp to get rid of it. See RT #35800
+ # for details.
+ $self->build_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/ );
+ $self->configure_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/ );
+ } else {
+ # Allow legacy-compatibility with 5.005 by depending on the
+ # most recent EU:MM that supported 5.005.
+ $self->build_requires( 'ExtUtils::MakeMaker' => 6.42 );
+ $self->configure_requires( 'ExtUtils::MakeMaker' => 6.42 );
+ }
+
+ # Generate the MakeMaker params
my $args = $self->makemaker_args;
$args->{DISTNAME} = $self->name;
- $args->{NAME} = $self->module_name || $self->name || $self->determine_NAME($args);
- $args->{VERSION} = $self->version || $self->determine_VERSION($args);
+ $args->{NAME} = $self->module_name || $self->name;
+ $args->{VERSION} = $self->version;
$args->{NAME} =~ s/-/::/g;
if ( $self->tests ) {
$args->{test} = { TESTS => $self->tests };
}
- if ($] >= 5.005) {
+ if ( $] >= 5.005 ) {
$args->{ABSTRACT} = $self->abstract;
$args->{AUTHOR} = $self->author;
}
@@ -141,7 +162,7 @@ sub write {
delete $args->{SIGN};
}
- # merge both kinds of requires into prereq_pm
+ # Merge both kinds of requires into prereq_pm
my $prereq = ($args->{PREREQ_PM} ||= {});
%$prereq = ( %$prereq,
map { @$_ }
@@ -175,7 +196,9 @@ sub write {
my $user_preop = delete $args{dist}->{PREOP};
if (my $preop = $self->admin->preop($user_preop)) {
- $args{dist} = $preop;
+ foreach my $key ( keys %$preop ) {
+ $args{dist}->{$key} = $preop->{$key};
+ }
}
my $mm = ExtUtils::MakeMaker::WriteMakefile(%args);
@@ -188,7 +211,7 @@ sub fix_up_makefile {
my $top_class = ref($self->_top) || '';
my $top_version = $self->_top->VERSION || '';
- my $preamble = $self->preamble
+ my $preamble = $self->preamble
? "# Preamble by $top_class $top_version\n"
. $self->preamble
: '';
@@ -242,4 +265,4 @@ sub postamble {
__END__
-#line 371
+#line 394
diff --git a/inc/Module/Install/Metadata.pm b/inc/Module/Install/Metadata.pm
index a39ffde..653193d 100644
--- a/inc/Module/Install/Metadata.pm
+++ b/inc/Module/Install/Metadata.pm
@@ -2,117 +2,254 @@
package Module::Install::Metadata;
use strict 'vars';
-use Module::Install::Base;
+use Module::Install::Base ();
-use vars qw{$VERSION $ISCORE @ISA};
+use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.70';
+ $VERSION = '0.91';
+ @ISA = 'Module::Install::Base';
$ISCORE = 1;
- @ISA = qw{Module::Install::Base};
}
+my @boolean_keys = qw{
+ sign
+};
+
my @scalar_keys = qw{
- name module_name abstract author version license
- distribution_type perl_version tests installdirs
+ name
+ module_name
+ abstract
+ author
+ version
+ distribution_type
+ tests
+ installdirs
};
my @tuple_keys = qw{
- configure_requires build_requires requires recommends bundles
+ configure_requires
+ build_requires
+ requires
+ recommends
+ bundles
+ resources
};
-sub Meta { shift }
-sub Meta_ScalarKeys { @scalar_keys }
-sub Meta_TupleKeys { @tuple_keys }
+my @resource_keys = qw{
+ homepage
+ bugtracker
+ repository
+};
+
+my @array_keys = qw{
+ keywords
+};
-foreach my $key (@scalar_keys) {
+sub Meta { shift }
+sub Meta_BooleanKeys { @boolean_keys }
+sub Meta_ScalarKeys { @scalar_keys }
+sub Meta_TupleKeys { @tuple_keys }
+sub Meta_ResourceKeys { @resource_keys }
+sub Meta_ArrayKeys { @array_keys }
+
+foreach my $key ( @boolean_keys ) {
*$key = sub {
my $self = shift;
- return $self->{values}{$key} if defined wantarray and !@_;
- $self->{values}{$key} = shift;
+ if ( defined wantarray and not @_ ) {
+ return $self->{values}->{$key};
+ }
+ $self->{values}->{$key} = ( @_ ? $_[0] : 1 );
return $self;
};
}
-foreach my $key (@tuple_keys) {
+foreach my $key ( @scalar_keys ) {
*$key = sub {
my $self = shift;
- return $self->{values}{$key} unless @_;
+ return $self->{values}->{$key} if defined wantarray and !@_;
+ $self->{values}->{$key} = shift;
+ return $self;
+ };
+}
+
+foreach my $key ( @array_keys ) {
+ *$key = sub {
+ my $self = shift;
+ return $self->{values}->{$key} if defined wantarray and !@_;
+ $self->{values}->{$key} ||= [];
+ push @{$self->{values}->{$key}}, @_;
+ return $self;
+ };
+}
- my @rv;
- while (@_) {
- my $module = shift or last;
+foreach my $key ( @resource_keys ) {
+ *$key = sub {
+ my $self = shift;
+ unless ( @_ ) {
+ return () unless $self->{values}->{resources};
+ return map { $_->[1] }
+ grep { $_->[0] eq $key }
+ @{ $self->{values}->{resources} };
+ }
+ return $self->{values}->{resources}->{$key} unless @_;
+ my $uri = shift or die(
+ "Did not provide a value to $key()"
+ );
+ $self->resources( $key => $uri );
+ return 1;
+ };
+}
+
+foreach my $key ( grep { $_ ne "resources" } @tuple_keys) {
+ *$key = sub {
+ my $self = shift;
+ return $self->{values}->{$key} unless @_;
+ my @added;
+ while ( @_ ) {
+ my $module = shift or last;
my $version = shift || 0;
- if ( $module eq 'perl' ) {
- $version =~ s{^(\d+)\.(\d+)\.(\d+)}
- {$1 + $2/1_000 + $3/1_000_000}e;
- $self->perl_version($version);
- next;
- }
- my $rv = [ $module, $version ];
- push @rv, $rv;
+ push @added, [ $module, $version ];
}
- push @{ $self->{values}{$key} }, @rv;
- @rv;
+ push @{ $self->{values}->{$key} }, @added;
+ return map {@$_} @added;
};
}
+# Resource handling
+my %lc_resource = map { $_ => 1 } qw{
+ homepage
+ license
+ bugtracker
+ repository
+};
+
+sub resources {
+ my $self = shift;
+ while ( @_ ) {
+ my $name = shift or last;
+ my $value = shift or next;
+ if ( $name eq lc $name and ! $lc_resource{$name} ) {
+ die("Unsupported reserved lowercase resource '$name'");
+ }
+ $self->{values}->{resources} ||= [];
+ push @{ $self->{values}->{resources} }, [ $name, $value ];
+ }
+ $self->{values}->{resources};
+}
+
# Aliases for build_requires that will have alternative
# meanings in some future version of META.yml.
-sub test_requires { shift->build_requires(@_) }
-sub install_requires { shift->build_requires(@_) }
+sub test_requires { shift->build_requires(@_) }
+sub install_requires { shift->build_requires(@_) }
# Aliases for installdirs options
-sub install_as_core { $_[0]->installdirs('perl') }
-sub install_as_cpan { $_[0]->installdirs('site') }
-sub install_as_site { $_[0]->installdirs('site') }
-sub install_as_vendor { $_[0]->installdirs('vendor') }
-
-sub sign {
- my $self = shift;
- return $self->{'values'}{'sign'} if defined wantarray and ! @_;
- $self->{'values'}{'sign'} = ( @_ ? $_[0] : 1 );
- return $self;
-}
+sub install_as_core { $_[0]->installdirs('perl') }
+sub install_as_cpan { $_[0]->installdirs('site') }
+sub install_as_site { $_[0]->installdirs('site') }
+sub install_as_vendor { $_[0]->installdirs('vendor') }
sub dynamic_config {
my $self = shift;
unless ( @_ ) {
- warn "You MUST provide an explicit true/false value to dynamic_config, skipping\n";
+ warn "You MUST provide an explicit true/false value to dynamic_config\n";
return $self;
}
- $self->{'values'}{'dynamic_config'} = $_[0] ? 1 : 0;
- return $self;
+ $self->{values}->{dynamic_config} = $_[0] ? 1 : 0;
+ return 1;
+}
+
+sub perl_version {
+ my $self = shift;
+ return $self->{values}->{perl_version} unless @_;
+ my $version = shift or die(
+ "Did not provide a value to perl_version()"
+ );
+
+ # Normalize the version
+ $version = $self->_perl_version($version);
+
+ # We don't support the reall old versions
+ unless ( $version >= 5.005 ) {
+ die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n";
+ }
+
+ $self->{values}->{perl_version} = $version;
+}
+
+#Stolen from M::B
+my %license_urls = (
+ perl => 'http://dev.perl.org/licenses/',
+ apache => 'http://apache.org/licenses/LICENSE-2.0',
+ artistic => 'http://opensource.org/licenses/artistic-license.php',
+ artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php',
+ lgpl => 'http://opensource.org/licenses/lgpl-license.php',
+ lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php',
+ lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html',
+ bsd => 'http://opensource.org/licenses/bsd-license.php',
+ gpl => 'http://opensource.org/licenses/gpl-license.php',
+ gpl2 => 'http://opensource.org/licenses/gpl-2.0.php',
+ gpl3 => 'http://opensource.org/licenses/gpl-3.0.html',
+ mit => 'http://opensource.org/licenses/mit-license.php',
+ mozilla => 'http://opensource.org/licenses/mozilla1.1.php',
+ open_source => undef,
+ unrestricted => undef,
+ restrictive => undef,
+ unknown => undef,
+);
+
+sub license {
+ my $self = shift;
+ return $self->{values}->{license} unless @_;
+ my $license = shift or die(
+ 'Did not provide a value to license()'
+ );
+ $self->{values}->{license} = $license;
+
+ # Automatically fill in license URLs
+ if ( $license_urls{$license} ) {
+ $self->resources( license => $license_urls{$license} );
+ }
+
+ return 1;
}
sub all_from {
my ( $self, $file ) = @_;
unless ( defined($file) ) {
- my $name = $self->name
- or die "all_from called with no args without setting name() first";
+ my $name = $self->name or die(
+ "all_from called with no args without setting name() first"
+ );
$file = join('/', 'lib', split(/-/, $name)) . '.pm';
$file =~ s{.*/}{} unless -e $file;
- die "all_from: cannot find $file from $name" unless -e $file;
+ unless ( -e $file ) {
+ die("all_from cannot find $file from $name");
+ }
}
+ unless ( -f $file ) {
+ die("The path '$file' does not exist, or is not a file");
+ }
+
+ # Some methods pull from POD instead of code.
+ # If there is a matching .pod, use that instead
+ my $pod = $file;
+ $pod =~ s/\.pm$/.pod/i;
+ $pod = $file unless -e $pod;
+ # Pull the different values
+ $self->name_from($file) unless $self->name;
$self->version_from($file) unless $self->version;
$self->perl_version_from($file) unless $self->perl_version;
+ $self->author_from($pod) unless $self->author;
+ $self->license_from($pod) unless $self->license;
+ $self->abstract_from($pod) unless $self->abstract;
- # The remaining probes read from POD sections; if the file
- # has an accompanying .pod, use that instead
- my $pod = $file;
- if ( $pod =~ s/\.pm$/.pod/i and -e $pod ) {
- $file = $pod;
- }
-
- $self->author_from($file) unless $self->author;
- $self->license_from($file) unless $self->license;
- $self->abstract_from($file) unless $self->abstract;
+ return 1;
}
sub provides {
my $self = shift;
- my $provides = ( $self->{values}{provides} ||= {} );
+ my $provides = ( $self->{values}->{provides} ||= {} );
%$provides = (%$provides, @_) if @_;
return $provides;
}
@@ -141,7 +278,7 @@ sub auto_provides {
sub feature {
my $self = shift;
my $name = shift;
- my $features = ( $self->{values}{features} ||= [] );
+ my $features = ( $self->{values}->{features} ||= [] );
my $mods;
if ( @_ == 1 and ref( $_[0] ) ) {
@@ -177,16 +314,16 @@ sub features {
sub no_index {
my $self = shift;
my $type = shift;
- push @{ $self->{values}{no_index}{$type} }, @_ if $type;
- return $self->{values}{no_index};
+ push @{ $self->{values}->{no_index}->{$type} }, @_ if $type;
+ return $self->{values}->{no_index};
}
sub read {
my $self = shift;
- $self->include_deps( 'YAML', 0 );
+ $self->include_deps( 'YAML::Tiny', 0 );
- require YAML;
- my $data = YAML::LoadFile('META.yml');
+ require YAML::Tiny;
+ my $data = YAML::Tiny::LoadFile('META.yml');
# Call methods explicitly in case user has already set some values.
while ( my ( $key, $value ) = each %$data ) {
@@ -226,35 +363,51 @@ sub abstract_from {
);
}
-sub _slurp {
- local *FH;
- open FH, "< $_[1]" or die "Cannot open $_[1].pod: $!";
- do { local $/; <FH> };
+# Add both distribution and module name
+sub name_from {
+ my ($self, $file) = @_;
+ if (
+ Module::Install::_read($file) =~ m/
+ ^ \s*
+ package \s*
+ ([\w:]+)
+ \s* ;
+ /ixms
+ ) {
+ my ($name, $module_name) = ($1, $1);
+ $name =~ s{::}{-}g;
+ $self->name($name);
+ unless ( $self->module_name ) {
+ $self->module_name($module_name);
+ }
+ } else {
+ die("Cannot determine name from $file\n");
+ }
}
sub perl_version_from {
- my ( $self, $file ) = @_;
+ my $self = shift;
if (
- $self->_slurp($file) =~ m/
+ Module::Install::_read($_[0]) =~ m/
^
- use \s*
+ (?:use|require) \s*
v?
([\d_\.]+)
\s* ;
/ixms
) {
- my $v = $1;
- $v =~ s{_}{}g;
- $self->perl_version($1);
+ my $perl_version = $1;
+ $perl_version =~ s{_}{}g;
+ $self->perl_version($perl_version);
} else {
- warn "Cannot determine perl version info from $file\n";
+ warn "Cannot determine perl version info from $_[0]\n";
return;
}
}
sub author_from {
- my ( $self, $file ) = @_;
- my $content = $self->_slurp($file);
+ my $self = shift;
+ my $content = Module::Install::_read($_[0]);
if ($content =~ m/
=head \d \s+ (?:authors?)\b \s*
([^\n]*)
@@ -268,15 +421,14 @@ sub author_from {
$author =~ s{E<gt>}{>}g;
$self->author($author);
} else {
- warn "Cannot determine author info from $file\n";
+ warn "Cannot determine author info from $_[0]\n";
}
}
sub license_from {
- my ( $self, $file ) = @_;
-
+ my $self = shift;
if (
- $self->_slurp($file) =~ m/
+ Module::Install::_read($_[0]) =~ m/
(
=head \d \s+
(?:licen[cs]e|licensing|copyright|legal)\b
@@ -287,32 +439,186 @@ sub license_from {
/ixms ) {
my $license_text = $1;
my @phrases = (
- 'under the same (?:terms|license) as perl itself' => 'perl', 1,
- 'GNU public license' => 'gpl', 1,
- 'GNU lesser public license' => 'lgpl', 1,
- 'BSD license' => 'bsd', 1,
- 'Artistic license' => 'artistic', 1,
- 'GPL' => 'gpl', 1,
- 'LGPL' => 'lgpl', 1,
- 'BSD' => 'bsd', 1,
- 'Artistic' => 'artistic', 1,
- 'MIT' => 'mit', 1,
- 'proprietary' => 'proprietary', 0,
+ 'under the same (?:terms|license) as (?:perl|the perl programming language) itself' => 'perl', 1,
+ 'GNU general public license' => 'gpl', 1,
+ 'GNU public license' => 'gpl', 1,
+ 'GNU lesser general public license' => 'lgpl', 1,
+ 'GNU lesser public license' => 'lgpl', 1,
+ 'GNU library general public license' => 'lgpl', 1,
+ 'GNU library public license' => 'lgpl', 1,
+ 'BSD license' => 'bsd', 1,
+ 'Artistic license' => 'artistic', 1,
+ 'GPL' => 'gpl', 1,
+ 'LGPL' => 'lgpl', 1,
+ 'BSD' => 'bsd', 1,
+ 'Artistic' => 'artistic', 1,
+ 'MIT' => 'mit', 1,
+ 'proprietary' => 'proprietary', 0,
);
while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) {
$pattern =~ s{\s+}{\\s+}g;
if ( $license_text =~ /\b$pattern\b/i ) {
- if ( $osi and $license_text =~ /All rights reserved/i ) {
- warn "LEGAL WARNING: 'All rights reserved' may invalidate Open Source licenses. Consider removing it.";
- }
$self->license($license);
return 1;
}
}
}
- warn "Cannot determine license info from $file\n";
+ warn "Cannot determine license info from $_[0]\n";
return 'unknown';
}
+sub _extract_bugtracker {
+ my @links = $_[0] =~ m#L<(\Qhttp://rt.cpan.org/\E[^>]+)>#g;
+ my %links;
+ @links{@links}=();
+ @links=keys %links;
+ return @links;
+}
+
+sub bugtracker_from {
+ my $self = shift;
+ my $content = Module::Install::_read($_[0]);
+ my @links = _extract_bugtracker($content);
+ unless ( @links ) {
+ warn "Cannot determine bugtracker info from $_[0]\n";
+ return 0;
+ }
+ if ( @links > 1 ) {
+ warn "Found more than on rt.cpan.org link in $_[0]\n";
+ return 0;
+ }
+
+ # Set the bugtracker
+ bugtracker( $links[0] );
+ return 1;
+}
+
+sub requires_from {
+ my $self = shift;
+ my $content = Module::Install::_readperl($_[0]);
+ my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg;
+ while ( @requires ) {
+ my $module = shift @requires;
+ my $version = shift @requires;
+ $self->requires( $module => $version );
+ }
+}
+
+sub test_requires_from {
+ my $self = shift;
+ my $content = Module::Install::_readperl($_[0]);
+ my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg;
+ while ( @requires ) {
+ my $module = shift @requires;
+ my $version = shift @requires;
+ $self->test_requires( $module => $version );
+ }
+}
+
+# Convert triple-part versions (eg, 5.6.1 or 5.8.9) to
+# numbers (eg, 5.006001 or 5.008009).
+# Also, convert double-part versions (eg, 5.8)
+sub _perl_version {
+ my $v = $_[-1];
+ $v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e;
+ $v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 || 0)/e;
+ $v =~ s/(\.\d\d\d)000$/$1/;
+ $v =~ s/_.+$//;
+ if ( ref($v) ) {
+ # Numify
+ $v = $v + 0;
+ }
+ return $v;
+}
+
+
+
+
+
+######################################################################
+# MYMETA Support
+
+sub WriteMyMeta {
+ die "WriteMyMeta has been deprecated";
+}
+
+sub write_mymeta_yaml {
+ my $self = shift;
+
+ # We need YAML::Tiny to write the MYMETA.yml file
+ unless ( eval { require YAML::Tiny; 1; } ) {
+ return 1;
+ }
+
+ # Generate the data
+ my $meta = $self->_write_mymeta_data or return 1;
+
+ # Save as the MYMETA.yml file
+ print "Writing MYMETA.yml\n";
+ YAML::Tiny::DumpFile('MYMETA.yml', $meta);
+}
+
+sub write_mymeta_json {
+ my $self = shift;
+
+ # We need JSON to write the MYMETA.json file
+ unless ( eval { require JSON; 1; } ) {
+ return 1;
+ }
+
+ # Generate the data
+ my $meta = $self->_write_mymeta_data or return 1;
+
+ # Save as the MYMETA.yml file
+ print "Writing MYMETA.json\n";
+ Module::Install::_write(
+ 'MYMETA.json',
+ JSON->new->pretty(1)->canonical->encode($meta),
+ );
+}
+
+sub _write_mymeta_data {
+ my $self = shift;
+
+ # If there's no existing META.yml there is nothing we can do
+ return undef unless -f 'META.yml';
+
+ # We need Parse::CPAN::Meta to load the file
+ unless ( eval { require Parse::CPAN::Meta; 1; } ) {
+ return undef;
+ }
+
+ # Merge the perl version into the dependencies
+ my $val = $self->Meta->{values};
+ my $perl = delete $val->{perl_version};
+ if ( $perl ) {
+ $val->{requires} ||= [];
+ my $requires = $val->{requires};
+
+ # Canonize to three-dot version after Perl 5.6
+ if ( $perl >= 5.006 ) {
+ $perl =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2||0), int($3||0))}e
+ }
+ unshift @$requires, [ perl => $perl ];
+ }
+
+ # Load the advisory META.yml file
+ my @yaml = Parse::CPAN::Meta::LoadFile('META.yml');
+ my $meta = $yaml[0];
+
+ # Overwrite the non-configure dependency hashs
+ delete $meta->{requires};
+ delete $meta->{build_requires};
+ delete $meta->{recommends};
+ if ( exists $val->{requires} ) {
+ $meta->{requires} = { map { @$_ } @{ $val->{requires} } };
+ }
+ if ( exists $val->{build_requires} ) {
+ $meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } };
+ }
+
+ return $meta;
+}
+
1;
diff --git a/inc/Module/Install/Win32.pm b/inc/Module/Install/Win32.pm
index 21a81ab..f2f99df 100644
--- a/inc/Module/Install/Win32.pm
+++ b/inc/Module/Install/Win32.pm
@@ -2,12 +2,12 @@
package Module::Install::Win32;
use strict;
-use Module::Install::Base;
+use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.70';
- @ISA = qw{Module::Install::Base};
+ $VERSION = '0.91';
+ @ISA = 'Module::Install::Base';
$ISCORE = 1;
}
diff --git a/inc/Module/Install/WriteAll.pm b/inc/Module/Install/WriteAll.pm
index a05592d..12471e5 100644
--- a/inc/Module/Install/WriteAll.pm
+++ b/inc/Module/Install/WriteAll.pm
@@ -2,11 +2,11 @@
package Module::Install::WriteAll;
use strict;
-use Module::Install::Base;
+use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.70';
+ $VERSION = '0.91';;
@ISA = qw{Module::Install::Base};
$ISCORE = 1;
}
@@ -22,7 +22,6 @@ sub WriteAll {
);
$self->sign(1) if $args{sign};
- $self->Meta->write if $args{meta};
$self->admin->WriteAll(%args) if $self->is_admin;
$self->check_nmake if $args{check_nmake};
@@ -30,11 +29,32 @@ sub WriteAll {
$self->makemaker_args( PL_FILES => {} );
}
+ # Until ExtUtils::MakeMaker support MYMETA.yml, make sure
+ # we clean it up properly ourself.
+ $self->realclean_files('MYMETA.yml');
+
if ( $args{inline} ) {
$self->Inline->write;
} else {
$self->Makefile->write;
}
+
+ # The Makefile write process adds a couple of dependencies,
+ # so write the META.yml files after the Makefile.
+ if ( $args{meta} ) {
+ $self->Meta->write;
+ }
+
+ # Experimental support for MYMETA
+ if ( $ENV{X_MYMETA} ) {
+ if ( $ENV{X_MYMETA} eq 'JSON' ) {
+ $self->Meta->write_mymeta_json;
+ } else {
+ $self->Meta->write_mymeta_yaml;
+ }
+ }
+
+ return 1;
}
1;
commit ead1373c084ad8f025d39d1434ffc6f6a9ed1269
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Wed Jun 10 20:36:22 2009 +0000
more MI upgrades
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@19968 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/META.yml b/META.yml
index f5e16ed..b07508d 100644
--- a/META.yml
+++ b/META.yml
@@ -1,21 +1,26 @@
----
-abstract: RT Authen-ExternalAuth Extension
-author:
- - Mike Peachey <zordrak at cpan.org>
+---
+abstract: 'RT Authen-ExternalAuth Extension'
+author:
+ - 'Mike Peachey <zordrak at cpan.org>'
+build_requires:
+ ExtUtils::MakeMaker: 6.42
+configure_requires:
+ ExtUtils::MakeMaker: 6.42
distribution_type: module
-generated_by: Module::Install version 0.70
-license: GPL version 2
-meta-spec:
- url: http://module-build.sourceforge.net/META-spec-v1.3.html
- version: 1.3
+generated_by: 'Module::Install version 0.91'
+license: 'GPL version 2'
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
name: RT-Authen-ExternalAuth
-no_index:
- directory:
+no_index:
+ directory:
- etc
- html
- - po
- - var
- inc
-requires:
- RT: 0
-version: 0.07_02
+recommends:
+ CGI::Cookies: 0
+ DBI: 0
+ Net::LDAP: 0
+ Net::SSLeay: 0
+version: 0.08
commit dd53f31afbfca744ad308b5ab9f8db5c61a29266
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Wed Jun 10 20:36:36 2009 +0000
Make feature/recommends more compatible with modern MI
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@19969 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/Makefile.PL b/Makefile.PL
index 0b3f65e..035001d 100755
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -7,18 +7,26 @@ author('Mike Peachey <zordrak at cpan.org>');
all_from('lib/RT/Authen/ExternalAuth.pm');
-features(
- 'SSL LDAP Connections' => [
+feature 'SSL LDAP Connections' =>
-default => 0,
- 'Net::SSLeay' => 0],
- 'External LDAP Sources' => [
+ recommends('Net::SSLeay' => 0),
+ ;
+
+feature 'External LDAP Sources' =>
-default => 1,
- 'Net::LDAP' => 0],
- 'External DBI Sources' => [
+ recommends('Net::LDAP' => 0),
+ ;
+
+feature 'External DBI Sources' =>
-default => 1,
- 'DBI' => 0],
- 'SSO Cookie Sources' => [
+ recommends('DBI' => 0),
+ ;
+
+feature 'SSO Cookie Sources' =>
-default => 1,
- 'CGI::Cookies' => 0]
-);
+ recommends('CGI::Cookies' => 0),
+ ;
+
+&auto_install();
+
&WriteAll;
commit e22b3b96e4c1cb2d5e13acef2b7739ee6d249a9d
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Wed Oct 21 19:21:44 2009 +0000
a rudimentary gitignore so git-svn is more usable
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@20126 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..0b5bd39
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,3 @@
+Makefile
+blib
+pm_to_blib
commit 5c66e2b0916a5ceeffaa12117872d3d8598e3201
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Wed Oct 21 19:22:17 2009 +0000
Use css to hide the password box for users with no password
This doesn't prevent updates, but most of the time when using
ExternalAuth, if you're logged in and don't have an internal password,
being prompted to change the internal password is confusing to the end
user.
For SelfService users, just don't grant them ModifySelf to hide the
password change.
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@20127 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/html/Callbacks/ExternalAuth/Elements/Header/Head b/html/Callbacks/ExternalAuth/Elements/Header/Head
new file mode 100644
index 0000000..7ba3b16
--- /dev/null
+++ b/html/Callbacks/ExternalAuth/Elements/Header/Head
@@ -0,0 +1,11 @@
+% if ( $session{CurrentUser}->UserObj->__Value('Password') eq '*NO-PASSWORD*') {
+<style>
+#user-prefs-password {
+ display: none;
+}
+</style>
+% }
+<%INIT>
+return unless $m->request_comp->path eq '/User/Prefs.html';
+return unless $session{CurrentUser} && $session{CurrentUser}->id;
+</%INIT>
commit 8de4b7a5350cf88e1dcd6047db5dfd6f54124d5f
Author: sunnavy <sunnavy at bestpractical.com>
Date: Fri Feb 18 07:42:06 2011 +0000
typo fix
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@20268 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/Makefile.PL b/Makefile.PL
index 035001d..3a60f7a 100755
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -24,7 +24,7 @@ feature 'External DBI Sources' =>
feature 'SSO Cookie Sources' =>
-default => 1,
- recommends('CGI::Cookies' => 0),
+ recommends('CGI::Cookie' => 0),
;
&auto_install();
commit bf058acf8c315c4532e36805123b2082b5d02c5b
Author: sunnavy <sunnavy at bestpractical.com>
Date: Fri Feb 18 07:42:11 2011 +0000
Login has been moved to /NoAuth, we need to prevent MaybeShowNoAuthPage returning page directly when people submit the login form
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@20269 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/lib/RT/Authen/ExternalAuth.pm b/lib/RT/Authen/ExternalAuth.pm
index 55dc8ad..03adbef 100644
--- a/lib/RT/Authen/ExternalAuth.pm
+++ b/lib/RT/Authen/ExternalAuth.pm
@@ -545,4 +545,19 @@ sub CanonicalizeUserInfo {
}
+{
+ if ( $RT::VERSION gt '3.8.8' ) {
+ no warnings 'redefine';
+ require RT::Interface::Web;
+ my $orig = \&RT::Interface::Web::MaybeShowNoAuthPage;
+ *RT::Interface::Web::MaybeShowNoAuthPage = sub {
+ my $m = $HTML::Mason::Commands::m;
+ return
+ if $m->base_comp->path eq '/NoAuth/Login.html'
+ && $m->cgi_object->request_method eq 'POST';
+ return $orig->(@_);
+ };
+ }
+}
+
1;
commit f2b00aaac007929b6c7062c1248cb58a53023922
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Fri Feb 18 20:24:42 2011 +0000
more useful ignores
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@20270 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/.gitignore b/.gitignore
index 0b5bd39..ffabd7e 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,3 +1,4 @@
Makefile
blib
pm_to_blib
+MANIFEST.bak
commit 1fe964ba1ab92d87c7d9283b1da229d96c056fd7
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Fri Feb 18 20:24:47 2011 +0000
Upgrade META.yml and Module::Install
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@20271 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/META.yml b/META.yml
index b07508d..ffda25b 100644
--- a/META.yml
+++ b/META.yml
@@ -7,8 +7,8 @@ build_requires:
configure_requires:
ExtUtils::MakeMaker: 6.42
distribution_type: module
-generated_by: 'Module::Install version 0.91'
-license: 'GPL version 2'
+generated_by: 'Module::Install version 1.00'
+license: gpl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
@@ -23,4 +23,10 @@ recommends:
DBI: 0
Net::LDAP: 0
Net::SSLeay: 0
+requires:
+ DBI: 0
+ Net::LDAP: 0
+ Net::SSLeay: 0
+resources:
+ license: http://opensource.org/licenses/gpl-license.php
version: 0.08
diff --git a/inc/Module/AutoInstall.pm b/inc/Module/AutoInstall.pm
index dfb8ef7..60b90ea 100644
--- a/inc/Module/AutoInstall.pm
+++ b/inc/Module/AutoInstall.pm
@@ -253,6 +253,8 @@ sub import {
# import to main::
no strict 'refs';
*{'main::WriteMakefile'} = \&Write if caller(0) eq 'main';
+
+ return (@Existing, @Missing);
}
sub _running_under {
@@ -672,7 +674,20 @@ sub _load {
sub _load_cpan {
return if $CPAN::VERSION and $CPAN::Config and not @_;
require CPAN;
- if ( $CPAN::HandleConfig::VERSION ) {
+
+ # CPAN-1.82+ adds CPAN::Config::AUTOLOAD to redirect to
+ # CPAN::HandleConfig->load. CPAN reports that the redirection
+ # is deprecated in a warning printed at the user.
+
+ # CPAN-1.81 expects CPAN::HandleConfig->load, does not have
+ # $CPAN::HandleConfig::VERSION but cannot handle
+ # CPAN::Config->load
+
+ # Which "versions expect CPAN::Config->load?
+
+ if ( $CPAN::HandleConfig::VERSION
+ || CPAN::HandleConfig->can('load')
+ ) {
# Newer versions of CPAN have a HandleConfig module
CPAN::HandleConfig->load;
} else {
@@ -802,4 +817,4 @@ END_MAKE
__END__
-#line 1056
+#line 1071
diff --git a/inc/Module/Install.pm b/inc/Module/Install.pm
index 51eda5d..8ee839d 100644
--- a/inc/Module/Install.pm
+++ b/inc/Module/Install.pm
@@ -19,6 +19,9 @@ package Module::Install;
use 5.005;
use strict 'vars';
+use Cwd ();
+use File::Find ();
+use File::Path ();
use vars qw{$VERSION $MAIN};
BEGIN {
@@ -28,7 +31,7 @@ BEGIN {
# This is not enforced yet, but will be some time in the next few
# releases once we can make sure it won't clash with custom
# Module::Install extensions.
- $VERSION = '0.91';
+ $VERSION = '1.00';
# Storage for the pseudo-singleton
$MAIN = undef;
@@ -38,18 +41,25 @@ BEGIN {
}
+sub import {
+ my $class = shift;
+ my $self = $class->new(@_);
+ my $who = $self->_caller;
-
-
-
-# Whether or not inc::Module::Install is actually loaded, the
-# $INC{inc/Module/Install.pm} is what will still get set as long as
-# the caller loaded module this in the documented manner.
-# If not set, the caller may NOT have loaded the bundled version, and thus
-# they may not have a MI version that works with the Makefile.PL. This would
-# result in false errors or unexpected behaviour. And we don't want that.
-my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
-unless ( $INC{$file} ) { die <<"END_DIE" }
+ #-------------------------------------------------------------
+ # all of the following checks should be included in import(),
+ # to allow "eval 'require Module::Install; 1' to test
+ # installation of Module::Install. (RT #51267)
+ #-------------------------------------------------------------
+
+ # Whether or not inc::Module::Install is actually loaded, the
+ # $INC{inc/Module/Install.pm} is what will still get set as long as
+ # the caller loaded module this in the documented manner.
+ # If not set, the caller may NOT have loaded the bundled version, and thus
+ # they may not have a MI version that works with the Makefile.PL. This would
+ # result in false errors or unexpected behaviour. And we don't want that.
+ my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
+ unless ( $INC{$file} ) { die <<"END_DIE" }
Please invoke ${\__PACKAGE__} with:
@@ -61,26 +71,28 @@ not:
END_DIE
-
-
-
-
-# If the script that is loading Module::Install is from the future,
-# then make will detect this and cause it to re-run over and over
-# again. This is bad. Rather than taking action to touch it (which
-# is unreliable on some platforms and requires write permissions)
-# for now we should catch this and refuse to run.
-if ( -f $0 ) {
- my $s = (stat($0))[9];
-
- # If the modification time is only slightly in the future,
- # sleep briefly to remove the problem.
- my $a = $s - time;
- if ( $a > 0 and $a < 5 ) { sleep 5 }
-
- # Too far in the future, throw an error.
- my $t = time;
- if ( $s > $t ) { die <<"END_DIE" }
+ # This reportedly fixes a rare Win32 UTC file time issue, but
+ # as this is a non-cross-platform XS module not in the core,
+ # we shouldn't really depend on it. See RT #24194 for detail.
+ # (Also, this module only supports Perl 5.6 and above).
+ eval "use Win32::UTCFileTime" if $^O eq 'MSWin32' && $] >= 5.006;
+
+ # If the script that is loading Module::Install is from the future,
+ # then make will detect this and cause it to re-run over and over
+ # again. This is bad. Rather than taking action to touch it (which
+ # is unreliable on some platforms and requires write permissions)
+ # for now we should catch this and refuse to run.
+ if ( -f $0 ) {
+ my $s = (stat($0))[9];
+
+ # If the modification time is only slightly in the future,
+ # sleep briefly to remove the problem.
+ my $a = $s - time;
+ if ( $a > 0 and $a < 5 ) { sleep 5 }
+
+ # Too far in the future, throw an error.
+ my $t = time;
+ if ( $s > $t ) { die <<"END_DIE" }
Your installer $0 has a modification time in the future ($s > $t).
@@ -89,15 +101,12 @@ This is known to create infinite loops in make.
Please correct this, then run $0 again.
END_DIE
-}
-
-
-
+ }
-# Build.PL was formerly supported, but no longer is due to excessive
-# difficulty in implementing every single feature twice.
-if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" }
+ # Build.PL was formerly supported, but no longer is due to excessive
+ # difficulty in implementing every single feature twice.
+ if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" }
Module::Install no longer supports Build.PL.
@@ -107,23 +116,42 @@ Please remove all Build.PL files and only use the Makefile.PL installer.
END_DIE
+ #-------------------------------------------------------------
+ # To save some more typing in Module::Install installers, every...
+ # use inc::Module::Install
+ # ...also acts as an implicit use strict.
+ $^H |= strict::bits(qw(refs subs vars));
+ #-------------------------------------------------------------
+ unless ( -f $self->{file} ) {
+ foreach my $key (keys %INC) {
+ delete $INC{$key} if $key =~ /Module\/Install/;
+ }
-# To save some more typing in Module::Install installers, every...
-# use inc::Module::Install
-# ...also acts as an implicit use strict.
-$^H |= strict::bits(qw(refs subs vars));
-
+ local $^W;
+ require "$self->{path}/$self->{dispatch}.pm";
+ File::Path::mkpath("$self->{prefix}/$self->{author}");
+ $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self );
+ $self->{admin}->init;
+ @_ = ($class, _self => $self);
+ goto &{"$self->{name}::import"};
+ }
+ local $^W;
+ *{"${who}::AUTOLOAD"} = $self->autoload;
+ $self->preload;
+ # Unregister loader and worker packages so subdirs can use them again
+ delete $INC{'inc/Module/Install.pm'};
+ delete $INC{'Module/Install.pm'};
+ # Save to the singleton
+ $MAIN = $self;
-use Cwd ();
-use File::Find ();
-use File::Path ();
-use FindBin;
+ return 1;
+}
sub autoload {
my $self = shift;
@@ -136,7 +164,21 @@ sub autoload {
# Delegate back to parent dirs
goto &$code unless $cwd eq $pwd;
}
- $$sym =~ /([^:]+)$/ or die "Cannot autoload $who - $sym";
+ unless ($$sym =~ s/([^:]+)$//) {
+ # XXX: it looks like we can't retrieve the missing function
+ # via $$sym (usually $main::AUTOLOAD) in this case.
+ # I'm still wondering if we should slurp Makefile.PL to
+ # get some context or not ...
+ my ($package, $file, $line) = caller;
+ die <<"EOT";
+Unknown function is found at $file line $line.
+Execution of $file aborted due to runtime errors.
+
+If you're a contributor to a project, you may need to install
+some Module::Install extensions from CPAN (or other repository).
+If you're a user of a module, please contact the author.
+EOT
+ }
my $method = $1;
if ( uc($method) eq $method ) {
# Do nothing
@@ -152,33 +194,6 @@ sub autoload {
};
}
-sub import {
- my $class = shift;
- my $self = $class->new(@_);
- my $who = $self->_caller;
-
- unless ( -f $self->{file} ) {
- require "$self->{path}/$self->{dispatch}.pm";
- File::Path::mkpath("$self->{prefix}/$self->{author}");
- $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self );
- $self->{admin}->init;
- @_ = ($class, _self => $self);
- goto &{"$self->{name}::import"};
- }
-
- *{"${who}::AUTOLOAD"} = $self->autoload;
- $self->preload;
-
- # Unregister loader and worker packages so subdirs can use them again
- delete $INC{"$self->{file}"};
- delete $INC{"$self->{path}.pm"};
-
- # Save to the singleton
- $MAIN = $self;
-
- return 1;
-}
-
sub preload {
my $self = shift;
unless ( $self->{extensions} ) {
@@ -204,6 +219,7 @@ sub preload {
my $who = $self->_caller;
foreach my $name ( sort keys %seen ) {
+ local $^W;
*{"${who}::$name"} = sub {
${"${who}::AUTOLOAD"} = "${who}::$name";
goto &{"${who}::AUTOLOAD"};
@@ -214,12 +230,18 @@ sub preload {
sub new {
my ($class, %args) = @_;
+ delete $INC{'FindBin.pm'};
+ {
+ # to suppress the redefine warning
+ local $SIG{__WARN__} = sub {};
+ require FindBin;
+ }
+
# ignore the prefix on extension modules built from top level.
my $base_path = Cwd::abs_path($FindBin::Bin);
unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) {
delete $args{prefix};
}
-
return $args{_self} if $args{_self};
$args{dispatch} ||= 'Admin';
@@ -272,8 +294,10 @@ END_DIE
sub load_extensions {
my ($self, $path, $top) = @_;
+ my $should_reload = 0;
unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) {
unshift @INC, $self->{prefix};
+ $should_reload = 1;
}
foreach my $rv ( $self->find_extensions($path) ) {
@@ -281,12 +305,13 @@ sub load_extensions {
next if $self->{pathnames}{$pkg};
local $@;
- my $new = eval { require $file; $pkg->can('new') };
+ my $new = eval { local $^W; require $file; $pkg->can('new') };
unless ( $new ) {
warn $@ if $@;
next;
}
- $self->{pathnames}{$pkg} = delete $INC{$file};
+ $self->{pathnames}{$pkg} =
+ $should_reload ? delete $INC{$file} : $INC{$file};
push @{$self->{extensions}}, &{$new}($pkg, _top => $top );
}
@@ -348,17 +373,24 @@ sub _caller {
return $call;
}
+# Done in evals to avoid confusing Perl::MinimumVersion
+eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
sub _read {
local *FH;
- if ( $] >= 5.006 ) {
- open( FH, '<', $_[0] ) or die "open($_[0]): $!";
- } else {
- open( FH, "< $_[0]" ) or die "open($_[0]): $!";
- }
+ open( FH, '<', $_[0] ) or die "open($_[0]): $!";
+ my $string = do { local $/; <FH> };
+ close FH or die "close($_[0]): $!";
+ return $string;
+}
+END_NEW
+sub _read {
+ local *FH;
+ open( FH, "< $_[0]" ) or die "open($_[0]): $!";
my $string = do { local $/; <FH> };
close FH or die "close($_[0]): $!";
return $string;
}
+END_OLD
sub _readperl {
my $string = Module::Install::_read($_[0]);
@@ -379,18 +411,26 @@ sub _readpod {
return $string;
}
+# Done in evals to avoid confusing Perl::MinimumVersion
+eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
sub _write {
local *FH;
- if ( $] >= 5.006 ) {
- open( FH, '>', $_[0] ) or die "open($_[0]): $!";
- } else {
- open( FH, "> $_[0]" ) or die "open($_[0]): $!";
+ open( FH, '>', $_[0] ) or die "open($_[0]): $!";
+ foreach ( 1 .. $#_ ) {
+ print FH $_[$_] or die "print($_[0]): $!";
}
+ close FH or die "close($_[0]): $!";
+}
+END_NEW
+sub _write {
+ local *FH;
+ open( FH, "> $_[0]" ) or die "open($_[0]): $!";
foreach ( 1 .. $#_ ) {
print FH $_[$_] or die "print($_[0]): $!";
}
close FH or die "close($_[0]): $!";
}
+END_OLD
# _version is for processing module versions (eg, 1.03_05) not
# Perl versions (eg, 5.8.1).
@@ -427,4 +467,4 @@ sub _CLASS ($) {
1;
-# Copyright 2008 - 2009 Adam Kennedy.
+# Copyright 2008 - 2010 Adam Kennedy.
diff --git a/inc/Module/Install/AutoInstall.pm b/inc/Module/Install/AutoInstall.pm
index 58dd026..f1f5356 100644
--- a/inc/Module/Install/AutoInstall.pm
+++ b/inc/Module/Install/AutoInstall.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.91';
+ $VERSION = '1.00';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -37,12 +37,33 @@ sub auto_install {
$self->include('Module::AutoInstall');
require Module::AutoInstall;
- Module::AutoInstall->import(
+ my @features_require = Module::AutoInstall->import(
(@config ? (-config => \@config) : ()),
(@core ? (-core => \@core) : ()),
$self->features,
);
+ my %seen;
+ my @requires = map @$_, map @$_, grep ref, $self->requires;
+ while (my ($mod, $ver) = splice(@requires, 0, 2)) {
+ $seen{$mod}{$ver}++;
+ }
+ my @build_requires = map @$_, map @$_, grep ref, $self->build_requires;
+ while (my ($mod, $ver) = splice(@build_requires, 0, 2)) {
+ $seen{$mod}{$ver}++;
+ }
+ my @configure_requires = map @$_, map @$_, grep ref, $self->configure_requires;
+ while (my ($mod, $ver) = splice(@configure_requires, 0, 2)) {
+ $seen{$mod}{$ver}++;
+ }
+
+ my @deduped;
+ while (my ($mod, $ver) = splice(@features_require, 0, 2)) {
+ push @deduped, $mod => $ver unless $seen{$mod}{$ver}++;
+ }
+
+ $self->requires(@deduped);
+
$self->makemaker_args( Module::AutoInstall::_make_args() );
my $class = ref($self);
diff --git a/inc/Module/Install/Base.pm b/inc/Module/Install/Base.pm
index 60a74d2..b55bda3 100644
--- a/inc/Module/Install/Base.pm
+++ b/inc/Module/Install/Base.pm
@@ -4,7 +4,7 @@ package Module::Install::Base;
use strict 'vars';
use vars qw{$VERSION};
BEGIN {
- $VERSION = '0.91';
+ $VERSION = '1.00';
}
# Suspend handler for "redefined" warnings
@@ -51,13 +51,18 @@ sub admin {
#line 106
sub is_admin {
- $_[0]->admin->VERSION;
+ ! $_[0]->admin->isa('Module::Install::Base::FakeAdmin');
}
sub DESTROY {}
package Module::Install::Base::FakeAdmin;
+use vars qw{$VERSION};
+BEGIN {
+ $VERSION = $Module::Install::Base::VERSION;
+}
+
my $fake;
sub new {
@@ -75,4 +80,4 @@ BEGIN {
1;
-#line 154
+#line 159
diff --git a/inc/Module/Install/Can.pm b/inc/Module/Install/Can.pm
index e65e4f6..71ccc27 100644
--- a/inc/Module/Install/Can.pm
+++ b/inc/Module/Install/Can.pm
@@ -9,7 +9,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.91';
+ $VERSION = '1.00';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
diff --git a/inc/Module/Install/Fetch.pm b/inc/Module/Install/Fetch.pm
index 05f2079..ec1f106 100644
--- a/inc/Module/Install/Fetch.pm
+++ b/inc/Module/Install/Fetch.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.91';
+ $VERSION = '1.00';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
diff --git a/inc/Module/Install/Include.pm b/inc/Module/Install/Include.pm
index 7e792e0..a28cd4c 100644
--- a/inc/Module/Install/Include.pm
+++ b/inc/Module/Install/Include.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.91';
+ $VERSION = '1.00';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
diff --git a/inc/Module/Install/Makefile.pm b/inc/Module/Install/Makefile.pm
index 98779db..5dfd0e9 100644
--- a/inc/Module/Install/Makefile.pm
+++ b/inc/Module/Install/Makefile.pm
@@ -4,10 +4,11 @@ package Module::Install::Makefile;
use strict 'vars';
use ExtUtils::MakeMaker ();
use Module::Install::Base ();
+use Fcntl qw/:flock :seek/;
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.91';
+ $VERSION = '1.00';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -25,8 +26,8 @@ sub prompt {
die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])";
}
- # In automated testing, always use defaults
- if ( $ENV{AUTOMATED_TESTING} and ! $ENV{PERL_MM_USE_DEFAULT} ) {
+ # In automated testing or non-interactive session, always use defaults
+ if ( ($ENV{AUTOMATED_TESTING} or -! -t STDIN) and ! $ENV{PERL_MM_USE_DEFAULT} ) {
local $ENV{PERL_MM_USE_DEFAULT} = 1;
goto &ExtUtils::MakeMaker::prompt;
} else {
@@ -34,21 +35,112 @@ sub prompt {
}
}
+# Store a cleaned up version of the MakeMaker version,
+# since we need to behave differently in a variety of
+# ways based on the MM version.
+my $makemaker = eval $ExtUtils::MakeMaker::VERSION;
+
+# If we are passed a param, do a "newer than" comparison.
+# Otherwise, just return the MakeMaker version.
+sub makemaker {
+ ( @_ < 2 or $makemaker >= eval($_[1]) ) ? $makemaker : 0
+}
+
+# Ripped from ExtUtils::MakeMaker 6.56, and slightly modified
+# as we only need to know here whether the attribute is an array
+# or a hash or something else (which may or may not be appendable).
+my %makemaker_argtype = (
+ C => 'ARRAY',
+ CONFIG => 'ARRAY',
+# CONFIGURE => 'CODE', # ignore
+ DIR => 'ARRAY',
+ DL_FUNCS => 'HASH',
+ DL_VARS => 'ARRAY',
+ EXCLUDE_EXT => 'ARRAY',
+ EXE_FILES => 'ARRAY',
+ FUNCLIST => 'ARRAY',
+ H => 'ARRAY',
+ IMPORTS => 'HASH',
+ INCLUDE_EXT => 'ARRAY',
+ LIBS => 'ARRAY', # ignore ''
+ MAN1PODS => 'HASH',
+ MAN3PODS => 'HASH',
+ META_ADD => 'HASH',
+ META_MERGE => 'HASH',
+ PL_FILES => 'HASH',
+ PM => 'HASH',
+ PMLIBDIRS => 'ARRAY',
+ PMLIBPARENTDIRS => 'ARRAY',
+ PREREQ_PM => 'HASH',
+ CONFIGURE_REQUIRES => 'HASH',
+ SKIP => 'ARRAY',
+ TYPEMAPS => 'ARRAY',
+ XS => 'HASH',
+# VERSION => ['version',''], # ignore
+# _KEEP_AFTER_FLUSH => '',
+
+ clean => 'HASH',
+ depend => 'HASH',
+ dist => 'HASH',
+ dynamic_lib=> 'HASH',
+ linkext => 'HASH',
+ macro => 'HASH',
+ postamble => 'HASH',
+ realclean => 'HASH',
+ test => 'HASH',
+ tool_autosplit => 'HASH',
+
+ # special cases where you can use makemaker_append
+ CCFLAGS => 'APPENDABLE',
+ DEFINE => 'APPENDABLE',
+ INC => 'APPENDABLE',
+ LDDLFLAGS => 'APPENDABLE',
+ LDFROM => 'APPENDABLE',
+);
+
sub makemaker_args {
- my $self = shift;
+ my ($self, %new_args) = @_;
my $args = ( $self->{makemaker_args} ||= {} );
- %$args = ( %$args, @_ );
+ foreach my $key (keys %new_args) {
+ if ($makemaker_argtype{$key}) {
+ if ($makemaker_argtype{$key} eq 'ARRAY') {
+ $args->{$key} = [] unless defined $args->{$key};
+ unless (ref $args->{$key} eq 'ARRAY') {
+ $args->{$key} = [$args->{$key}]
+ }
+ push @{$args->{$key}},
+ ref $new_args{$key} eq 'ARRAY'
+ ? @{$new_args{$key}}
+ : $new_args{$key};
+ }
+ elsif ($makemaker_argtype{$key} eq 'HASH') {
+ $args->{$key} = {} unless defined $args->{$key};
+ foreach my $skey (keys %{ $new_args{$key} }) {
+ $args->{$key}{$skey} = $new_args{$key}{$skey};
+ }
+ }
+ elsif ($makemaker_argtype{$key} eq 'APPENDABLE') {
+ $self->makemaker_append($key => $new_args{$key});
+ }
+ }
+ else {
+ if (defined $args->{$key}) {
+ warn qq{MakeMaker attribute "$key" is overriden; use "makemaker_append" to append values\n};
+ }
+ $args->{$key} = $new_args{$key};
+ }
+ }
return $args;
}
# For mm args that take multiple space-seperated args,
# append an argument to the current list.
sub makemaker_append {
- my $self = sShift;
+ my $self = shift;
my $name = shift;
my $args = $self->makemaker_args;
- $args->{name} = defined $args->{$name}
- ? join( ' ', $args->{name}, @_ )
+ $args->{$name} = defined $args->{$name}
+ ? join( ' ', $args->{$name}, @_ )
: join( ' ', @_ );
}
@@ -89,25 +181,22 @@ sub inc {
$self->makemaker_args( INC => shift );
}
-my %test_dir = ();
-
sub _wanted_t {
- /\.t$/ and -f $_ and $test_dir{$File::Find::dir} = 1;
}
sub tests_recursive {
my $self = shift;
- if ( $self->tests ) {
- die "tests_recursive will not work if tests are already defined";
- }
my $dir = shift || 't';
unless ( -d $dir ) {
die "tests_recursive dir '$dir' does not exist";
}
- %test_dir = ();
+ my %tests = map { $_ => 1 } split / /, ($self->tests || '');
require File::Find;
- File::Find::find( \&_wanted_t, $dir );
- $self->tests( join ' ', map { "$_/*.t" } sort keys %test_dir );
+ File::Find::find(
+ sub { /\.t$/ and -f $_ and $tests{"$File::Find::dir/*.t"} = 1 },
+ $dir
+ );
+ $self->tests( join ' ', sort keys %tests );
}
sub write {
@@ -130,12 +219,13 @@ sub write {
# an underscore, even though its own version may contain one!
# Hence the funny regexp to get rid of it. See RT #35800
# for details.
- $self->build_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/ );
- $self->configure_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/ );
+ my $v = $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/;
+ $self->build_requires( 'ExtUtils::MakeMaker' => $v );
+ $self->configure_requires( 'ExtUtils::MakeMaker' => $v );
} else {
# Allow legacy-compatibility with 5.005 by depending on the
# most recent EU:MM that supported 5.005.
- $self->build_requires( 'ExtUtils::MakeMaker' => 6.42 );
+ $self->build_requires( 'ExtUtils::MakeMaker' => 6.42 );
$self->configure_requires( 'ExtUtils::MakeMaker' => 6.42 );
}
@@ -143,59 +233,115 @@ sub write {
my $args = $self->makemaker_args;
$args->{DISTNAME} = $self->name;
$args->{NAME} = $self->module_name || $self->name;
- $args->{VERSION} = $self->version;
$args->{NAME} =~ s/-/::/g;
+ $args->{VERSION} = $self->version or die <<'EOT';
+ERROR: Can't determine distribution version. Please specify it
+explicitly via 'version' in Makefile.PL, or set a valid $VERSION
+in a module, and provide its file path via 'version_from' (or
+'all_from' if you prefer) in Makefile.PL.
+EOT
+
+ $DB::single = 1;
if ( $self->tests ) {
- $args->{test} = { TESTS => $self->tests };
+ my @tests = split ' ', $self->tests;
+ my %seen;
+ $args->{test} = {
+ TESTS => (join ' ', grep {!$seen{$_}++} @tests),
+ };
+ } elsif ( $Module::Install::ExtraTests::use_extratests ) {
+ # Module::Install::ExtraTests doesn't set $self->tests and does its own tests via harness.
+ # So, just ignore our xt tests here.
+ } elsif ( -d 'xt' and ($Module::Install::AUTHOR or $ENV{RELEASE_TESTING}) ) {
+ $args->{test} = {
+ TESTS => join( ' ', map { "$_/*.t" } grep { -d $_ } qw{ t xt } ),
+ };
}
if ( $] >= 5.005 ) {
$args->{ABSTRACT} = $self->abstract;
- $args->{AUTHOR} = $self->author;
+ $args->{AUTHOR} = join ', ', @{$self->author || []};
}
- if ( eval($ExtUtils::MakeMaker::VERSION) >= 6.10 ) {
- $args->{NO_META} = 1;
+ if ( $self->makemaker(6.10) ) {
+ $args->{NO_META} = 1;
+ #$args->{NO_MYMETA} = 1;
}
- if ( eval($ExtUtils::MakeMaker::VERSION) > 6.17 and $self->sign ) {
+ if ( $self->makemaker(6.17) and $self->sign ) {
$args->{SIGN} = 1;
}
unless ( $self->is_admin ) {
delete $args->{SIGN};
}
+ if ( $self->makemaker(6.31) and $self->license ) {
+ $args->{LICENSE} = $self->license;
+ }
- # Merge both kinds of requires into prereq_pm
my $prereq = ($args->{PREREQ_PM} ||= {});
%$prereq = ( %$prereq,
- map { @$_ }
+ map { @$_ } # flatten [module => version]
map { @$_ }
grep $_,
- ($self->configure_requires, $self->build_requires, $self->requires)
+ ($self->requires)
);
# Remove any reference to perl, PREREQ_PM doesn't support it
delete $args->{PREREQ_PM}->{perl};
- # merge both kinds of requires into prereq_pm
- my $subdirs = ($args->{DIR} ||= []);
+ # Merge both kinds of requires into BUILD_REQUIRES
+ my $build_prereq = ($args->{BUILD_REQUIRES} ||= {});
+ %$build_prereq = ( %$build_prereq,
+ map { @$_ } # flatten [module => version]
+ map { @$_ }
+ grep $_,
+ ($self->configure_requires, $self->build_requires)
+ );
+
+ # Remove any reference to perl, BUILD_REQUIRES doesn't support it
+ delete $args->{BUILD_REQUIRES}->{perl};
+
+ # Delete bundled dists from prereq_pm, add it to Makefile DIR
+ my $subdirs = ($args->{DIR} || []);
if ($self->bundles) {
+ my %processed;
foreach my $bundle (@{ $self->bundles }) {
- my ($file, $dir) = @$bundle;
- push @$subdirs, $dir if -d $dir;
- delete $prereq->{$file};
+ my ($mod_name, $dist_dir) = @$bundle;
+ delete $prereq->{$mod_name};
+ $dist_dir = File::Basename::basename($dist_dir); # dir for building this module
+ if (not exists $processed{$dist_dir}) {
+ if (-d $dist_dir) {
+ # List as sub-directory to be processed by make
+ push @$subdirs, $dist_dir;
+ }
+ # Else do nothing: the module is already present on the system
+ $processed{$dist_dir} = undef;
+ }
}
}
+ unless ( $self->makemaker('6.55_03') ) {
+ %$prereq = (%$prereq,%$build_prereq);
+ delete $args->{BUILD_REQUIRES};
+ }
+
if ( my $perl_version = $self->perl_version ) {
eval "use $perl_version; 1"
or die "ERROR: perl: Version $] is installed, "
. "but we need version >= $perl_version";
+
+ if ( $self->makemaker(6.48) ) {
+ $args->{MIN_PERL_VERSION} = $perl_version;
+ }
}
- $args->{INSTALLDIRS} = $self->installdirs;
+ if ($self->installdirs) {
+ warn qq{old INSTALLDIRS (probably set by makemaker_args) is overriden by installdirs\n} if $args->{INSTALLDIRS};
+ $args->{INSTALLDIRS} = $self->installdirs;
+ }
- my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_})} keys %$args;
+ my %args = map {
+ ( $_ => $args->{$_} ) } grep {defined($args->{$_} )
+ } keys %$args;
my $user_preop = delete $args{dist}->{PREOP};
- if (my $preop = $self->admin->preop($user_preop)) {
+ if ( my $preop = $self->admin->preop($user_preop) ) {
foreach my $key ( keys %$preop ) {
$args{dist}->{$key} = $preop->{$key};
}
@@ -219,9 +365,9 @@ sub fix_up_makefile {
. ($self->postamble || '');
local *MAKEFILE;
- open MAKEFILE, "< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
+ open MAKEFILE, "+< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
+ eval { flock MAKEFILE, LOCK_EX };
my $makefile = do { local $/; <MAKEFILE> };
- close MAKEFILE or die $!;
$makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /;
$makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g;
@@ -241,7 +387,8 @@ sub fix_up_makefile {
# XXX - This is currently unused; not sure if it breaks other MM-users
# $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg;
- open MAKEFILE, "> $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
+ seek MAKEFILE, 0, SEEK_SET;
+ truncate MAKEFILE, 0;
print MAKEFILE "$preamble$makefile$postamble" or die $!;
close MAKEFILE or die $!;
@@ -265,4 +412,4 @@ sub postamble {
__END__
-#line 394
+#line 541
diff --git a/inc/Module/Install/Metadata.pm b/inc/Module/Install/Metadata.pm
index 653193d..cfe45b3 100644
--- a/inc/Module/Install/Metadata.pm
+++ b/inc/Module/Install/Metadata.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.91';
+ $VERSION = '1.00';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -19,7 +19,6 @@ my @scalar_keys = qw{
name
module_name
abstract
- author
version
distribution_type
tests
@@ -43,8 +42,11 @@ my @resource_keys = qw{
my @array_keys = qw{
keywords
+ author
};
+*authors = \&author;
+
sub Meta { shift }
sub Meta_BooleanKeys { @boolean_keys }
sub Meta_ScalarKeys { @scalar_keys }
@@ -176,43 +178,6 @@ sub perl_version {
$self->{values}->{perl_version} = $version;
}
-#Stolen from M::B
-my %license_urls = (
- perl => 'http://dev.perl.org/licenses/',
- apache => 'http://apache.org/licenses/LICENSE-2.0',
- artistic => 'http://opensource.org/licenses/artistic-license.php',
- artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php',
- lgpl => 'http://opensource.org/licenses/lgpl-license.php',
- lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php',
- lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html',
- bsd => 'http://opensource.org/licenses/bsd-license.php',
- gpl => 'http://opensource.org/licenses/gpl-license.php',
- gpl2 => 'http://opensource.org/licenses/gpl-2.0.php',
- gpl3 => 'http://opensource.org/licenses/gpl-3.0.html',
- mit => 'http://opensource.org/licenses/mit-license.php',
- mozilla => 'http://opensource.org/licenses/mozilla1.1.php',
- open_source => undef,
- unrestricted => undef,
- restrictive => undef,
- unknown => undef,
-);
-
-sub license {
- my $self = shift;
- return $self->{values}->{license} unless @_;
- my $license = shift or die(
- 'Did not provide a value to license()'
- );
- $self->{values}->{license} = $license;
-
- # Automatically fill in license URLs
- if ( $license_urls{$license} ) {
- $self->resources( license => $license_urls{$license} );
- }
-
- return 1;
-}
-
sub all_from {
my ( $self, $file ) = @_;
@@ -230,6 +195,8 @@ sub all_from {
die("The path '$file' does not exist, or is not a file");
}
+ $self->{values}{all_from} = $file;
+
# Some methods pull from POD instead of code.
# If there is a matching .pod, use that instead
my $pod = $file;
@@ -240,7 +207,7 @@ sub all_from {
$self->name_from($file) unless $self->name;
$self->version_from($file) unless $self->version;
$self->perl_version_from($file) unless $self->perl_version;
- $self->author_from($pod) unless $self->author;
+ $self->author_from($pod) unless @{$self->author || []};
$self->license_from($pod) unless $self->license;
$self->abstract_from($pod) unless $self->abstract;
@@ -350,6 +317,9 @@ sub version_from {
require ExtUtils::MM_Unix;
my ( $self, $file ) = @_;
$self->version( ExtUtils::MM_Unix->parse_version($file) );
+
+ # for version integrity check
+ $self->makemaker_args( VERSION_FROM => $file );
}
sub abstract_from {
@@ -360,7 +330,7 @@ sub abstract_from {
{ DISTNAME => $self->name },
'ExtUtils::MM_Unix'
)->parse_abstract($file)
- );
+ );
}
# Add both distribution and module name
@@ -385,11 +355,10 @@ sub name_from {
}
}
-sub perl_version_from {
- my $self = shift;
+sub _extract_perl_version {
if (
- Module::Install::_read($_[0]) =~ m/
- ^
+ $_[0] =~ m/
+ ^\s*
(?:use|require) \s*
v?
([\d_\.]+)
@@ -398,6 +367,16 @@ sub perl_version_from {
) {
my $perl_version = $1;
$perl_version =~ s{_}{}g;
+ return $perl_version;
+ } else {
+ return;
+ }
+}
+
+sub perl_version_from {
+ my $self = shift;
+ my $perl_version=_extract_perl_version(Module::Install::_read($_[0]));
+ if ($perl_version) {
$self->perl_version($perl_version);
} else {
warn "Cannot determine perl version info from $_[0]\n";
@@ -417,59 +396,164 @@ sub author_from {
([^\n]*)
/ixms) {
my $author = $1 || $2;
- $author =~ s{E<lt>}{<}g;
- $author =~ s{E<gt>}{>}g;
+
+ # XXX: ugly but should work anyway...
+ if (eval "require Pod::Escapes; 1") {
+ # Pod::Escapes has a mapping table.
+ # It's in core of perl >= 5.9.3, and should be installed
+ # as one of the Pod::Simple's prereqs, which is a prereq
+ # of Pod::Text 3.x (see also below).
+ $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> }
+ {
+ defined $2
+ ? chr($2)
+ : defined $Pod::Escapes::Name2character_number{$1}
+ ? chr($Pod::Escapes::Name2character_number{$1})
+ : do {
+ warn "Unknown escape: E<$1>";
+ "E<$1>";
+ };
+ }gex;
+ }
+ elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) {
+ # Pod::Text < 3.0 has yet another mapping table,
+ # though the table name of 2.x and 1.x are different.
+ # (1.x is in core of Perl < 5.6, 2.x is in core of
+ # Perl < 5.9.3)
+ my $mapping = ($Pod::Text::VERSION < 2)
+ ? \%Pod::Text::HTML_Escapes
+ : \%Pod::Text::ESCAPES;
+ $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> }
+ {
+ defined $2
+ ? chr($2)
+ : defined $mapping->{$1}
+ ? $mapping->{$1}
+ : do {
+ warn "Unknown escape: E<$1>";
+ "E<$1>";
+ };
+ }gex;
+ }
+ else {
+ $author =~ s{E<lt>}{<}g;
+ $author =~ s{E<gt>}{>}g;
+ }
$self->author($author);
} else {
warn "Cannot determine author info from $_[0]\n";
}
}
-sub license_from {
+#Stolen from M::B
+my %license_urls = (
+ perl => 'http://dev.perl.org/licenses/',
+ apache => 'http://apache.org/licenses/LICENSE-2.0',
+ apache_1_1 => 'http://apache.org/licenses/LICENSE-1.1',
+ artistic => 'http://opensource.org/licenses/artistic-license.php',
+ artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php',
+ lgpl => 'http://opensource.org/licenses/lgpl-license.php',
+ lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php',
+ lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html',
+ bsd => 'http://opensource.org/licenses/bsd-license.php',
+ gpl => 'http://opensource.org/licenses/gpl-license.php',
+ gpl2 => 'http://opensource.org/licenses/gpl-2.0.php',
+ gpl3 => 'http://opensource.org/licenses/gpl-3.0.html',
+ mit => 'http://opensource.org/licenses/mit-license.php',
+ mozilla => 'http://opensource.org/licenses/mozilla1.1.php',
+ open_source => undef,
+ unrestricted => undef,
+ restrictive => undef,
+ unknown => undef,
+);
+
+sub license {
my $self = shift;
- if (
- Module::Install::_read($_[0]) =~ m/
- (
- =head \d \s+
- (?:licen[cs]e|licensing|copyright|legal)\b
- .*?
- )
- (=head\\d.*|=cut.*|)
- \z
- /ixms ) {
- my $license_text = $1;
- my @phrases = (
- 'under the same (?:terms|license) as (?:perl|the perl programming language) itself' => 'perl', 1,
- 'GNU general public license' => 'gpl', 1,
- 'GNU public license' => 'gpl', 1,
- 'GNU lesser general public license' => 'lgpl', 1,
- 'GNU lesser public license' => 'lgpl', 1,
- 'GNU library general public license' => 'lgpl', 1,
- 'GNU library public license' => 'lgpl', 1,
- 'BSD license' => 'bsd', 1,
- 'Artistic license' => 'artistic', 1,
- 'GPL' => 'gpl', 1,
- 'LGPL' => 'lgpl', 1,
- 'BSD' => 'bsd', 1,
- 'Artistic' => 'artistic', 1,
- 'MIT' => 'mit', 1,
- 'proprietary' => 'proprietary', 0,
- );
- while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) {
- $pattern =~ s{\s+}{\\s+}g;
- if ( $license_text =~ /\b$pattern\b/i ) {
- $self->license($license);
- return 1;
- }
+ return $self->{values}->{license} unless @_;
+ my $license = shift or die(
+ 'Did not provide a value to license()'
+ );
+ $license = __extract_license($license) || lc $license;
+ $self->{values}->{license} = $license;
+
+ # Automatically fill in license URLs
+ if ( $license_urls{$license} ) {
+ $self->resources( license => $license_urls{$license} );
+ }
+
+ return 1;
+}
+
+sub _extract_license {
+ my $pod = shift;
+ my $matched;
+ return __extract_license(
+ ($matched) = $pod =~ m/
+ (=head \d \s+ L(?i:ICEN[CS]E|ICENSING)\b.*?)
+ (=head \d.*|=cut.*|)\z
+ /xms
+ ) || __extract_license(
+ ($matched) = $pod =~ m/
+ (=head \d \s+ (?:C(?i:OPYRIGHTS?)|L(?i:EGAL))\b.*?)
+ (=head \d.*|=cut.*|)\z
+ /xms
+ );
+}
+
+sub __extract_license {
+ my $license_text = shift or return;
+ my @phrases = (
+ '(?:under )?the same (?:terms|license) as (?:perl|the perl (?:\d )?programming language)' => 'perl', 1,
+ '(?:under )?the terms of (?:perl|the perl programming language) itself' => 'perl', 1,
+ 'Artistic and GPL' => 'perl', 1,
+ 'GNU general public license' => 'gpl', 1,
+ 'GNU public license' => 'gpl', 1,
+ 'GNU lesser general public license' => 'lgpl', 1,
+ 'GNU lesser public license' => 'lgpl', 1,
+ 'GNU library general public license' => 'lgpl', 1,
+ 'GNU library public license' => 'lgpl', 1,
+ 'GNU Free Documentation license' => 'unrestricted', 1,
+ 'GNU Affero General Public License' => 'open_source', 1,
+ '(?:Free)?BSD license' => 'bsd', 1,
+ 'Artistic license' => 'artistic', 1,
+ 'Apache (?:Software )?license' => 'apache', 1,
+ 'GPL' => 'gpl', 1,
+ 'LGPL' => 'lgpl', 1,
+ 'BSD' => 'bsd', 1,
+ 'Artistic' => 'artistic', 1,
+ 'MIT' => 'mit', 1,
+ 'Mozilla Public License' => 'mozilla', 1,
+ 'Q Public License' => 'open_source', 1,
+ 'OpenSSL License' => 'unrestricted', 1,
+ 'SSLeay License' => 'unrestricted', 1,
+ 'zlib License' => 'open_source', 1,
+ 'proprietary' => 'proprietary', 0,
+ );
+ while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) {
+ $pattern =~ s#\s+#\\s+#gs;
+ if ( $license_text =~ /\b$pattern\b/i ) {
+ return $license;
}
}
+ return '';
+}
- warn "Cannot determine license info from $_[0]\n";
- return 'unknown';
+sub license_from {
+ my $self = shift;
+ if (my $license=_extract_license(Module::Install::_read($_[0]))) {
+ $self->license($license);
+ } else {
+ warn "Cannot determine license info from $_[0]\n";
+ return 'unknown';
+ }
}
sub _extract_bugtracker {
- my @links = $_[0] =~ m#L<(\Qhttp://rt.cpan.org/\E[^>]+)>#g;
+ my @links = $_[0] =~ m#L<(
+ \Qhttp://rt.cpan.org/\E[^>]+|
+ \Qhttp://github.com/\E[\w_]+/[\w_]+/issues|
+ \Qhttp://code.google.com/p/\E[\w_\-]+/issues/list
+ )>#gx;
my %links;
@links{@links}=();
@links=keys %links;
@@ -485,7 +569,7 @@ sub bugtracker_from {
return 0;
}
if ( @links > 1 ) {
- warn "Found more than on rt.cpan.org link in $_[0]\n";
+ warn "Found more than one bugtracker link in $_[0]\n";
return 0;
}
@@ -532,8 +616,15 @@ sub _perl_version {
return $v;
}
-
-
+sub add_metadata {
+ my $self = shift;
+ my %hash = @_;
+ for my $key (keys %hash) {
+ warn "add_metadata: $key is not prefixed with 'x_'.\n" .
+ "Use appopriate function to add non-private metadata.\n" unless $key =~ /^x_/;
+ $self->{values}->{$key} = $hash{$key};
+ }
+}
######################################################################
diff --git a/inc/Module/Install/RTx.pm b/inc/Module/Install/RTx.pm
index 20a354b..f027f78 100644
--- a/inc/Module/Install/RTx.pm
+++ b/inc/Module/Install/RTx.pm
@@ -8,7 +8,7 @@ no warnings 'once';
use Module::Install::Base;
use base 'Module::Install::Base';
-our $VERSION = '0.24';
+our $VERSION = '0.27';
use FindBin;
use File::Glob ();
@@ -42,15 +42,16 @@ sub RTx {
$INC{'RT.pm'} = "$RT::LocalPath/lib/RT.pm";
} else {
local @INC = (
- @INC,
$ENV{RTHOME} ? ( $ENV{RTHOME}, "$ENV{RTHOME}/lib" ) : (),
+ @INC,
map { ( "$_/rt3/lib", "$_/lib/rt3", "$_/lib" ) } grep $_,
@prefixes
);
until ( eval { require RT; $RT::LocalPath } ) {
warn
"Cannot find the location of RT.pm that defines \$RT::LocalPath in: @INC\n";
- $_ = $self->prompt("Path to your RT.pm:") or exit;
+ $_ = $self->prompt("Path to directory containing your RT.pm:") or exit;
+ $_ =~ s/\/RT\.pm$//;
push @INC, $_, "$_/rt3/lib", "$_/lib/rt3", "$_/lib";
}
}
@@ -59,6 +60,7 @@ sub RTx {
my $local_lib_path = "$RT::LocalPath/lib";
print "Using RT configuration from $INC{'RT.pm'}:\n";
unshift @INC, "$RT::LocalPath/lib" if $RT::LocalPath;
+ unshift @INC, $lib_path;
$RT::LocalVarPath ||= $RT::VarPath;
$RT::LocalPoPath ||= $RT::LocalLexiconPath;
@@ -188,4 +190,4 @@ sub RTxInit {
__END__
-#line 302
+#line 304
diff --git a/inc/Module/Install/Win32.pm b/inc/Module/Install/Win32.pm
index f2f99df..edc18b4 100644
--- a/inc/Module/Install/Win32.pm
+++ b/inc/Module/Install/Win32.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.91';
+ $VERSION = '1.00';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
diff --git a/inc/Module/Install/WriteAll.pm b/inc/Module/Install/WriteAll.pm
index 12471e5..d0f6599 100644
--- a/inc/Module/Install/WriteAll.pm
+++ b/inc/Module/Install/WriteAll.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.91';;
+ $VERSION = '1.00';
@ISA = qw{Module::Install::Base};
$ISCORE = 1;
}
@@ -26,7 +26,10 @@ sub WriteAll {
$self->check_nmake if $args{check_nmake};
unless ( $self->makemaker_args->{PL_FILES} ) {
- $self->makemaker_args( PL_FILES => {} );
+ # XXX: This still may be a bit over-defensive...
+ unless ($self->makemaker(6.25)) {
+ $self->makemaker_args( PL_FILES => {} ) if -f 'Build.PL';
+ }
}
# Until ExtUtils::MakeMaker support MYMETA.yml, make sure
commit 63c89094c329c8541da7faa255ea7931442e85c5
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Fri Feb 18 23:59:02 2011 +0000
more meta.yml fixes
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@20272 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/META.yml b/META.yml
index ffda25b..0d91d61 100644
--- a/META.yml
+++ b/META.yml
@@ -19,11 +19,12 @@ no_index:
- html
- inc
recommends:
- CGI::Cookies: 0
+ CGI::Cookie: 0
DBI: 0
Net::LDAP: 0
Net::SSLeay: 0
requires:
+ CGI::Cookie: 0
DBI: 0
Net::LDAP: 0
Net::SSLeay: 0
commit 201c5ac3bcee426b341baef7f6bf2cbae9689be9
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Fri Feb 18 23:59:04 2011 +0000
Revert "Login has been moved to /NoAuth, we need to prevent MaybeShowNoAuthPage returning page directly when people submit the login form"
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@20273 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/lib/RT/Authen/ExternalAuth.pm b/lib/RT/Authen/ExternalAuth.pm
index 03adbef..55dc8ad 100644
--- a/lib/RT/Authen/ExternalAuth.pm
+++ b/lib/RT/Authen/ExternalAuth.pm
@@ -545,19 +545,4 @@ sub CanonicalizeUserInfo {
}
-{
- if ( $RT::VERSION gt '3.8.8' ) {
- no warnings 'redefine';
- require RT::Interface::Web;
- my $orig = \&RT::Interface::Web::MaybeShowNoAuthPage;
- *RT::Interface::Web::MaybeShowNoAuthPage = sub {
- my $m = $HTML::Mason::Commands::m;
- return
- if $m->base_comp->path eq '/NoAuth/Login.html'
- && $m->cgi_object->request_method eq 'POST';
- return $orig->(@_);
- };
- }
-}
-
1;
commit c4d53ec6d9bf493b70183e53c1b47f8d1505d3dd
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Fri Feb 18 23:59:07 2011 +0000
Work around some changes to Login flow in 3.8.9 and 4.0
In 3.8.9/4.0, we now need to hook the earlier callback, Session, in
order to avoid being skipped by the MaybeShowNoAuthPage method since
we're using a /NoAuth/Login.html page to collect login information.
This degrades nicely on 3.8.8 since the Session callback isn't called.
The Auth callback will get invoked on 3.8.9 but should bail quickly
because the user is logged in already.
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@20274 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/html/Callbacks/ExternalAuth/autohandler/Auth b/html/Callbacks/ExternalAuth/autohandler/Auth
index e188be4..3cae3fd 100644
--- a/html/Callbacks/ExternalAuth/autohandler/Auth
+++ b/html/Callbacks/ExternalAuth/autohandler/Auth
@@ -1,36 +1 @@
-<%once>
-my $loaded_user = 0;
-</%once>
-<%init>
-
-use RT::Authen::ExternalAuth;
-
-###################################################################################
-# Work around a bug in the RT 3.8.0 and 3.8.1 plugin system (fixed in 3.8.2) #
-# Temporarily force RT to reload RT::User, since it isn't being loaded #
-# correctly as a plugin. #
-###################################################################################
-unless ($loaded_user) {
- $RT::Logger->debug("Reloading RT::User to work around a bug in RT-3.8.0 and RT-3.8.1");
- $loaded_user++;
- delete $INC{'RT/User.pm'};
- delete $INC{'RT/User_Overlay.pm'};
- delete $INC{'RT/User_Vendor.pm'};
- require RT::User;
-}
-###################################################################################
-
-my ($val,$msg);
-unless($session{'CurrentUser'} && $session{'CurrentUser'}->Id) {
- ($val,$msg) = RT::Authen::ExternalAuth::DoAuth(\%session,$user,$pass);
- $RT::Logger->debug("Autohandler called ExternalAuth. Response: ($val, $msg)");
-}
-
-return;
-</%init>
-
-<%ARGS>
-$user => undef
-$pass => undef
-$menu => undef
-</%ARGS>
+%$m->comp('/Elements/DoAuth',%ARGS);
diff --git a/html/Callbacks/ExternalAuth/autohandler/Session b/html/Callbacks/ExternalAuth/autohandler/Session
new file mode 100644
index 0000000..3cae3fd
--- /dev/null
+++ b/html/Callbacks/ExternalAuth/autohandler/Session
@@ -0,0 +1 @@
+%$m->comp('/Elements/DoAuth',%ARGS);
diff --git a/html/Callbacks/ExternalAuth/autohandler/Auth b/html/Elements/DoAuth
similarity index 93%
copy from html/Callbacks/ExternalAuth/autohandler/Auth
copy to html/Elements/DoAuth
index e188be4..a0eea8d 100644
--- a/html/Callbacks/ExternalAuth/autohandler/Auth
+++ b/html/Elements/DoAuth
@@ -10,7 +10,7 @@ use RT::Authen::ExternalAuth;
# Temporarily force RT to reload RT::User, since it isn't being loaded #
# correctly as a plugin. #
###################################################################################
-unless ($loaded_user) {
+unless ($loaded_user) {
$RT::Logger->debug("Reloading RT::User to work around a bug in RT-3.8.0 and RT-3.8.1");
$loaded_user++;
delete $INC{'RT/User.pm'};
@@ -34,3 +34,4 @@ $user => undef
$pass => undef
$menu => undef
</%ARGS>
+
commit f65c78c719f762facf0c7048c1a2385903767c81
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Sat Feb 19 00:44:15 2011 +0000
Changelogging and distribution frobbing for 0.08_01
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@20275 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/ChangeLog b/ChangeLog
index 85f8353..d971598 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,4 +1,15 @@
-v0.09_01 2009-03-28 Mike Peachey <zordrak at cpan.org>
+v0.08_01 2011-02-18 Kevin Falcone
+ * Testing prerelase for 0.09, since 0.09_01 never made it to CPAN
+ * Upgrade Module::Install
+ * Remove and then replace a requires('RT') since Module::Install::RTx now
+ handles that
+ * Fix the features/recommends to work with modern MI
+ * Use CSS to hide password box for ExternalAuth users so they don't think
+ they can change their password via RT
+ * Fix for 3.8.9/4.0.0 to work with new Login infrastructure
+
+
+NEVER RELEASED v0.09_01 2009-03-28 Mike Peachey <zordrak at cpan.org>
* Makefile.PL
diff --git a/MANIFEST b/MANIFEST
index 0673a83..91224d6 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -1,10 +1,16 @@
ChangeLog
etc/RT_SiteConfig.pm
html/Callbacks/ExternalAuth/autohandler/Auth
+html/Callbacks/ExternalAuth/autohandler/Session
+html/Callbacks/ExternalAuth/Elements/Header/Head
+html/Elements/DoAuth
+inc/Module/AutoInstall.pm
inc/Module/Install.pm
+inc/Module/Install/AutoInstall.pm
inc/Module/Install/Base.pm
inc/Module/Install/Can.pm
inc/Module/Install/Fetch.pm
+inc/Module/Install/Include.pm
inc/Module/Install/Makefile.pm
inc/Module/Install/Metadata.pm
inc/Module/Install/RTx.pm
@@ -12,8 +18,8 @@ inc/Module/Install/Win32.pm
inc/Module/Install/WriteAll.pm
lib/RT/Authen/ExternalAuth.pm
lib/RT/Authen/ExternalAuth/DBI.pm
-lib/RT/Authen/ExternalAuth/LDAP.pm
lib/RT/Authen/ExternalAuth/DBI/Cookie.pm
+lib/RT/Authen/ExternalAuth/LDAP.pm
lib/RT/User_Vendor.pm
LICENSE
Makefile.PL
diff --git a/META.yml b/META.yml
index 0d91d61..4e7aa56 100644
--- a/META.yml
+++ b/META.yml
@@ -30,4 +30,4 @@ requires:
Net::SSLeay: 0
resources:
license: http://opensource.org/licenses/gpl-license.php
-version: 0.08
+version: 0.08_01
diff --git a/lib/RT/Authen/ExternalAuth.pm b/lib/RT/Authen/ExternalAuth.pm
index 55dc8ad..be5fa08 100644
--- a/lib/RT/Authen/ExternalAuth.pm
+++ b/lib/RT/Authen/ExternalAuth.pm
@@ -1,6 +1,6 @@
package RT::Authen::ExternalAuth;
-our $VERSION = '0.08';
+our $VERSION = '0.08_01';
=head1 NAME
commit 6f5658844070805e612522ed9978f79bc8c2f3ec
Author: sunnavy <sunnavy at bestpractical.com>
Date: Sun Feb 20 13:29:07 2011 +0000
customized CanonicalizeUserInfo in User_Vendor.pm makes RT::Test cry, so move it to ExternalAuth.pm
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@20276 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/lib/RT/Authen/ExternalAuth.pm b/lib/RT/Authen/ExternalAuth.pm
index be5fa08..c36715e 100644
--- a/lib/RT/Authen/ExternalAuth.pm
+++ b/lib/RT/Authen/ExternalAuth.pm
@@ -545,4 +545,13 @@ sub CanonicalizeUserInfo {
}
+{
+ no warnings 'redefine';
+ *RT::User::CanonicalizeUserInfo = sub {
+ my $self = shift;
+ my $args = shift;
+ return ( CanonicalizeUserInfo( $self, $args ) );
+ };
+}
+
1;
diff --git a/lib/RT/User_Vendor.pm b/lib/RT/User_Vendor.pm
deleted file mode 100644
index bc7110c..0000000
--- a/lib/RT/User_Vendor.pm
+++ /dev/null
@@ -1,27 +0,0 @@
-no warnings qw(redefine);
-use strict;
-use RT::Authen::ExternalAuth;
-
-# {{{ sub CanonicalizeUserInfo
-
-=head2 CanonicalizeUserInfo HASHREF
-
-Get all ExternalDB attrs listed in $RT::ExternalDBAttrMap and put them into
-the hash referred to by HASHREF.
-
-returns true (1) if ExternalDB lookup was successful, false (undef)
-in all other cases.
-
-=cut
-
-sub CanonicalizeUserInfo {
- my $self = shift;
- my $args = shift;
- return(RT::Authen::ExternalAuth::CanonicalizeUserInfo($self,$args));
-}
-# }}}
-
-
-
-
-1;
commit 91ab2387849fcffe8c99b443f9789368c2980ee9
Author: sunnavy <sunnavy at bestpractical.com>
Date: Sun Feb 20 13:30:30 2011 +0000
simple ldap test
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@20277 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/t/ldap.t b/t/ldap.t
new file mode 100644
index 0000000..a31b40d
--- /dev/null
+++ b/t/ldap.t
@@ -0,0 +1,64 @@
+use strict;
+use warnings;
+
+use RT::Test tests => 6;
+use Net::LDAP;
+use RT::Authen::ExternalAuth;
+
+eval { require Net::LDAP::Server::Test; 1; } or do {
+ plan skip_all => 'Unable to test without Net::Server::LDAP::Test';
+};
+
+
+my $ldap_port = 1024 + int rand(10000) + $$ % 1024;
+ok( my $server = Net::LDAP::Server::Test->new( $ldap_port, auto_schema => 1 ),
+ "spawned test LDAP server on port $ldap_port" );
+
+my $ldap = Net::LDAP->new("localhost:$ldap_port");
+$ldap->bind();
+my $username = "testuser";
+my $dn = "uid=$username,dc=bestpractical,dc=com";
+my $entry = {
+ cn => $username,
+ mail => "$username\@invalid.tld",
+ uid => $username,
+ objectClass => 'User',
+ userPassword => 'password',
+};
+$ldap->add( $dn, attr => [%$entry] );
+
+RT->Config->Set( Plugins => 'RT::Authen::ExternalAuth' );
+RT->Config->Set( ExternalAuthPriority => ['My_LDAP'] );
+RT->Config->Set( ExternalServiceUsesSSLorTLS => 0 );
+RT->Config->Set( AutoCreateNonExternalUsers => 0 );
+RT->Config->Set(
+ ExternalSettings => { # AN EXAMPLE DB SERVICE
+ 'My_LDAP' => {
+ 'type' => 'ldap',
+ 'server' => "127.0.0.1:$ldap_port",
+ 'base' => 'dc=bestpractical,dc=com',
+ 'filter' => '()',
+ 'd_filter' => '(objectClass=*)',
+ 'tls' => 0,
+ 'net_ldap_args' => [ version => 3 ],
+ 'attr_match_list' => [ 'uid', 'EmailAddress' ],
+ 'attr_map' => {
+ 'Name' => 'uid',
+ 'EmailAddress' => 'mail',
+ }
+ },
+ }
+);
+my ( $baseurl, $m ) = RT::Test->started_ok();
+ok( !$m->login( 'fakeuser', 'password' ), 'not logged in with fake user' );
+ok( $m->login( 'testuser', 'password' ), 'logged in' );
+$m->logout;
+
+$m->get_ok( $baseurl, 'base url' );
+$m->submit_form(
+ form_number => 1,
+ fields => { user => 'testuser', pass => 'password', },
+);
+$m->text_contains('Logout', 'logged in via form');
+
+$ldap->unbind();
commit 48d0569bb7b3377e5179edf0587b765c68b146c9
Author: sunnavy <sunnavy at bestpractical.com>
Date: Sun Feb 20 13:30:48 2011 +0000
need to hack for the right redirect
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@20278 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/html/Callbacks/ExternalAuth/autohandler/Session b/html/Callbacks/ExternalAuth/autohandler/Session
index 3cae3fd..ceffb6b 100644
--- a/html/Callbacks/ExternalAuth/autohandler/Session
+++ b/html/Callbacks/ExternalAuth/autohandler/Session
@@ -1 +1,14 @@
-%$m->comp('/Elements/DoAuth',%ARGS);
+<%init>
+$m->comp('/Elements/DoAuth',%ARGS);
+
+# 3.8.9 doesn't redirect to the specified page if request has one.
+if ( $m->request_comp->path eq '/NoAuth/Login.html'
+ && RT::Interface::Web::_UserLoggedIn()
+ && $ARGS{next} )
+{
+ my $next = delete $session{'NextPage'}->{ $ARGS{'next'} };
+ if ($next) {
+ RT::Interface::Web::Redirect( $next || RT->Config->Get('WebURL') );
+ }
+}
+</%init>
commit cd5ae7ec840987684d240f56c91cfc9947854fa3
Author: sunnavy <sunnavy at bestpractical.com>
Date: Sun Feb 20 13:37:32 2011 +0000
test redirect after login
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@20279 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/t/ldap.t b/t/ldap.t
index a31b40d..507f264 100644
--- a/t/ldap.t
+++ b/t/ldap.t
@@ -1,7 +1,7 @@
use strict;
use warnings;
-use RT::Test tests => 6;
+use RT::Test tests => 9;
use Net::LDAP;
use RT::Authen::ExternalAuth;
@@ -50,15 +50,36 @@ RT->Config->Set(
}
);
my ( $baseurl, $m ) = RT::Test->started_ok();
-ok( !$m->login( 'fakeuser', 'password' ), 'not logged in with fake user' );
-ok( $m->login( 'testuser', 'password' ), 'logged in' );
-$m->logout;
-$m->get_ok( $baseurl, 'base url' );
-$m->submit_form(
- form_number => 1,
- fields => { user => 'testuser', pass => 'password', },
-);
-$m->text_contains('Logout', 'logged in via form');
+
+diag "test uri login";
+{
+ ok( !$m->login( 'fakeuser', 'password' ), 'not logged in with fake user' );
+ ok( $m->login( 'testuser', 'password' ), 'logged in' );
+}
+
+diag "test form login";
+{
+ $m->logout;
+ $m->get_ok( $baseurl, 'base url' );
+ $m->submit_form(
+ form_number => 1,
+ fields => { user => 'testuser', pass => 'password', },
+ );
+ $m->text_contains( 'Logout', 'logged in via form' );
+}
+
+diag "test redirect after login";
+{
+ $m->logout;
+ $m->get_ok( $baseurl . '/SelfService/Closed.html', 'closed tickets page' );
+ $m->submit_form(
+ form_number => 1,
+ fields => { user => 'testuser', pass => 'password', },
+ );
+ $m->text_contains( 'Logout', 'logged in' );
+ is( $m->uri, $baseurl . '/SelfService/Closed.html' );
+}
$ldap->unbind();
+
commit cf7c32ace475613673c9cac65cf2769ccb2c2f29
Author: sunnavy <sunnavy at bestpractical.com>
Date: Tue Feb 22 07:02:17 2011 +0000
check the default created user is unprivileged
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@20280 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/t/ldap.t b/t/ldap.t
index 507f264..08452fe 100644
--- a/t/ldap.t
+++ b/t/ldap.t
@@ -1,7 +1,7 @@
use strict;
use warnings;
-use RT::Test tests => 9;
+use RT::Test tests => 10;
use Net::LDAP;
use RT::Authen::ExternalAuth;
@@ -31,6 +31,7 @@ RT->Config->Set( Plugins => 'RT::Authen::ExternalAuth' );
RT->Config->Set( ExternalAuthPriority => ['My_LDAP'] );
RT->Config->Set( ExternalServiceUsesSSLorTLS => 0 );
RT->Config->Set( AutoCreateNonExternalUsers => 0 );
+RT->Config->Set( AutoCreate => undef );
RT->Config->Set(
ExternalSettings => { # AN EXAMPLE DB SERVICE
'My_LDAP' => {
@@ -49,8 +50,8 @@ RT->Config->Set(
},
}
);
-my ( $baseurl, $m ) = RT::Test->started_ok();
+my ( $baseurl, $m ) = RT::Test->started_ok();
diag "test uri login";
{
@@ -69,6 +70,8 @@ diag "test form login";
$m->text_contains( 'Logout', 'logged in via form' );
}
+is( $m->uri, $baseurl . '/SelfService/' , 'selfservice page' );
+
diag "test redirect after login";
{
$m->logout;
@@ -81,5 +84,6 @@ diag "test redirect after login";
is( $m->uri, $baseurl . '/SelfService/Closed.html' );
}
+
$ldap->unbind();
commit f414dec154c517d836b5295e412239ad95d21f5e
Author: sunnavy <sunnavy at bestpractical.com>
Date: Tue Feb 22 07:02:22 2011 +0000
test create privileged users
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@20281 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/t/ldap_privileged.t b/t/ldap_privileged.t
new file mode 100644
index 0000000..f9ab5c4
--- /dev/null
+++ b/t/ldap_privileged.t
@@ -0,0 +1,75 @@
+use strict;
+use warnings;
+
+use RT::Test tests => 7;
+use Net::LDAP;
+use RT::Authen::ExternalAuth;
+
+eval { require Net::LDAP::Server::Test; 1; } or do {
+ plan skip_all => 'Unable to test without Net::Server::LDAP::Test';
+};
+
+my $ldap_port = 1024 + int rand(10000) + $$ % 1024;
+ok( my $server = Net::LDAP::Server::Test->new( $ldap_port, auto_schema => 1 ),
+ "spawned test LDAP server on port $ldap_port" );
+
+my $ldap = Net::LDAP->new("localhost:$ldap_port");
+$ldap->bind();
+my $username = "testuser";
+my $dn = "uid=$username,dc=bestpractical,dc=com";
+my $entry = {
+ cn => $username,
+ mail => "$username\@invalid.tld",
+ uid => $username,
+ objectClass => 'User',
+ userPassword => 'password',
+};
+$ldap->add( $dn, attr => [%$entry] );
+
+RT->Config->Set( Plugins => 'RT::Authen::ExternalAuth' );
+RT->Config->Set( ExternalAuthPriority => ['My_LDAP'] );
+RT->Config->Set( ExternalServiceUsesSSLorTLS => 0 );
+RT->Config->Set( AutoCreateNonExternalUsers => 0 );
+RT->Config->Set( AutoCreate => { Privileged => 1 } );
+RT->Config->Set(
+ ExternalSettings => { # AN EXAMPLE DB SERVICE
+ 'My_LDAP' => {
+ 'type' => 'ldap',
+ 'server' => "127.0.0.1:$ldap_port",
+ 'base' => 'dc=bestpractical,dc=com',
+ 'filter' => '()',
+ 'd_filter' => '(objectClass=*)',
+ 'tls' => 0,
+ 'net_ldap_args' => [ version => 3 ],
+ 'attr_match_list' => [ 'uid', 'EmailAddress' ],
+ 'attr_map' => {
+ 'Name' => 'uid',
+ 'EmailAddress' => 'mail',
+ }
+ },
+ }
+);
+
+my ( $baseurl, $m ) = RT::Test->started_ok();
+
+diag "test uri login";
+{
+ ok( !$m->login( 'fakeuser', 'password' ), 'not logged in with fake user' );
+ ok( $m->login( 'testuser', 'password' ), 'logged in' );
+}
+
+diag "test form login";
+{
+ $m->logout;
+ $m->get_ok( $baseurl, 'base url' );
+ $m->submit_form(
+ form_number => 1,
+ fields => { user => 'testuser', pass => 'password', },
+ );
+ $m->text_contains( 'Logout', 'logged in via form' );
+}
+
+is( $m->uri, $baseurl . '/', 'not selfservice page' );
+
+$ldap->unbind();
+
commit f65fe445281a6c09dbcd76b9fffc33c13382ca89
Author: sunnavy <sunnavy at bestpractical.com>
Date: Wed Feb 23 10:32:38 2011 +0000
support sqlite too
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@20282 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/lib/RT/Authen/ExternalAuth/DBI.pm b/lib/RT/Authen/ExternalAuth/DBI.pm
index a707d5e..7099632 100644
--- a/lib/RT/Authen/ExternalAuth/DBI.pm
+++ b/lib/RT/Authen/ExternalAuth/DBI.pm
@@ -434,7 +434,13 @@ sub _GetBoundDBIObj {
my $dbi_driver = $config->{'dbi_driver'};
# Use config to create a DSN line for the DBI connection
- my $dsn = "dbi:$dbi_driver:database=$db_database;host=$db_server;port=$db_port";
+ my $dsn;
+ if ( $dbi_driver eq 'SQLite' ) {
+ $dsn = "dbi:$dbi_driver:$db_database";
+ }
+ else {
+ $dsn = "dbi:$dbi_driver:database=$db_database;host=$db_server;port=$db_port";
+ }
# Now let's get connected
my $dbh = DBI->connect($dsn, $db_user, $db_pass,{RaiseError => 1, AutoCommit => 0 })
commit ea1dc9a6658a06c426671e037c207963a0bb01cf
Author: sunnavy <sunnavy at bestpractical.com>
Date: Wed Feb 23 10:32:43 2011 +0000
sqlite test
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@20283 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/t/sqlite.t b/t/sqlite.t
new file mode 100644
index 0000000..dbe0875
--- /dev/null
+++ b/t/sqlite.t
@@ -0,0 +1,90 @@
+use strict;
+use warnings;
+
+use RT::Test tests => 10;
+use DBI;
+use File::Temp;
+use Digest::MD5;
+use File::Spec;
+
+eval { require DBD::SQLite; } or do {
+ plan skip_all => 'Unable to test without DBD::SQLite';
+};
+
+my $dir = File::Temp::tempdir( CLEANUP => 1 );
+my $dbname = File::Spec->catfile( $dir, 'rtauthtest' );
+my $table = 'users';
+my $dbh = DBI->connect("dbi:SQLite:$dbname");
+my $password = Digest::MD5::md5_hex('password');
+my $schema = <<"EOF";
+CREATE TABLE users (
+ username varchar(200) NOT NULL,
+ password varchar(40) NULL,
+ email varchar(16) NULL
+);
+EOF
+$dbh->do( $schema );
+$dbh->do(
+"INSERT INTO $table VALUES ( 'testuser', '$password', 'testuser\@invalid.tld')"
+);
+
+RT->Config->Set( Plugins => 'RT::Authen::ExternalAuth' );
+RT->Config->Set( ExternalAuthPriority => ['My_SQLite'] );
+RT->Config->Set( ExternalInfoPriority => ['My_SQLite'] );
+RT->Config->Set( ExternalServiceUsesSSLorTLS => 0 );
+RT->Config->Set( AutoCreateNonExternalUsers => 0 );
+RT->Config->Set( AutoCreate => undef );
+RT->Config->Set(
+ ExternalSettings => {
+ 'My_SQLite' => {
+ 'type' => 'db',
+ 'database' => $dbname,
+ 'table' => $table,
+ 'dbi_driver' => 'SQLite',
+ 'u_field' => 'username',
+ 'p_field' => 'password',
+ 'p_enc_pkg' => 'Digest::MD5',
+ 'p_enc_sub' => 'md5_hex',
+ 'attr_match_list' => ['Name'],
+ 'attr_map' => {
+ 'Name' => 'username',
+ 'EmailAddress' => 'email',
+ 'ExternalAuthId' => 'username',
+ }
+ },
+ }
+);
+
+my ( $baseurl, $m ) = RT::Test->started_ok();
+
+diag "test uri login";
+{
+ ok( !$m->login( 'fakeuser', 'password' ), 'not logged in with fake user' );
+ ok( !$m->login( 'testuser', 'wrongpassword' ), 'not logged in with wrong password' );
+ ok( $m->login( 'testuser', 'password' ), 'logged in' );
+}
+diag "test form login";
+{
+ $m->logout;
+ $m->get_ok( $baseurl, 'base url' );
+ $m->submit_form(
+ form_number => 1,
+ fields => { user => 'testuser', pass => 'password', },
+ );
+ $m->text_contains( 'Logout', 'logged in via form' );
+}
+
+is( $m->uri, $baseurl . '/SelfService/', 'selfservice page' );
+
+diag "test redirect after login";
+{
+ $m->logout;
+ $m->get_ok( $baseurl . '/SelfService/Closed.html', 'closed tickets page' );
+ $m->submit_form(
+ form_number => 1,
+ fields => { user => 'testuser', pass => 'password', },
+ );
+ $m->text_contains( 'Logout', 'logged in' );
+ is( $m->uri, $baseurl . '/SelfService/Closed.html' );
+}
+
commit 3557ce49501250fafd03b66f469a2b6fdd38ef6c
Author: sunnavy <sunnavy at bestpractical.com>
Date: Tue Mar 8 07:46:02 2011 +0000
home page may end in index.html
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@20284 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/t/ldap_privileged.t b/t/ldap_privileged.t
index f9ab5c4..b284021 100644
--- a/t/ldap_privileged.t
+++ b/t/ldap_privileged.t
@@ -69,7 +69,7 @@ diag "test form login";
$m->text_contains( 'Logout', 'logged in via form' );
}
-is( $m->uri, $baseurl . '/', 'not selfservice page' );
+like( $m->uri, qr!$baseurl/(index\.html)?!, 'privileged home page' );
$ldap->unbind();
commit 81d9e80f3323205121d7e77f15fb6e8b499b92ac
Author: sunnavy <sunnavy at bestpractical.com>
Date: Tue Mar 8 07:46:06 2011 +0000
make test happy with rt4
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@20285 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/t/ldap.t b/t/ldap.t
index 08452fe..01c48c1 100644
--- a/t/ldap.t
+++ b/t/ldap.t
@@ -87,3 +87,4 @@ diag "test redirect after login";
$ldap->unbind();
+$RT::Test::Web::DESTROY++; # not test warnings
diff --git a/t/ldap_privileged.t b/t/ldap_privileged.t
index b284021..12de47f 100644
--- a/t/ldap_privileged.t
+++ b/t/ldap_privileged.t
@@ -73,3 +73,4 @@ like( $m->uri, qr!$baseurl/(index\.html)?!, 'privileged home page' );
$ldap->unbind();
+$RT::Test::Web::DESTROY++; # not test warnings
diff --git a/t/sqlite.t b/t/sqlite.t
index dbe0875..bbc588d 100644
--- a/t/sqlite.t
+++ b/t/sqlite.t
@@ -88,3 +88,4 @@ diag "test redirect after login";
is( $m->uri, $baseurl . '/SelfService/Closed.html' );
}
+$RT::Test::Web::DESTROY++; # not test warnings
commit 834dc67de7b52fc35f9620318275c8bc674899ad
Author: sunnavy <sunnavy at bestpractical.com>
Date: Wed Mar 9 03:09:56 2011 +0000
skip warnings tests in a less hacky way
git-svn-id: svn+ssh://svn.bestpractical.com/svn/bps-public/RT-Authen-ExternalAuth/trunk@20286 e417ac7c-1bcc-0310-8ffa-8f5827389a85
diff --git a/t/ldap.t b/t/ldap.t
index 01c48c1..a974597 100644
--- a/t/ldap.t
+++ b/t/ldap.t
@@ -1,7 +1,7 @@
use strict;
use warnings;
-use RT::Test tests => 10;
+use RT::Test;
use Net::LDAP;
use RT::Authen::ExternalAuth;
@@ -84,7 +84,6 @@ diag "test redirect after login";
is( $m->uri, $baseurl . '/SelfService/Closed.html' );
}
-
$ldap->unbind();
-$RT::Test::Web::DESTROY++; # not test warnings
+$m->get_warnings;
diff --git a/t/ldap_privileged.t b/t/ldap_privileged.t
index 12de47f..c6c5f65 100644
--- a/t/ldap_privileged.t
+++ b/t/ldap_privileged.t
@@ -1,7 +1,7 @@
use strict;
use warnings;
-use RT::Test tests => 7;
+use RT::Test;
use Net::LDAP;
use RT::Authen::ExternalAuth;
@@ -73,4 +73,4 @@ like( $m->uri, qr!$baseurl/(index\.html)?!, 'privileged home page' );
$ldap->unbind();
-$RT::Test::Web::DESTROY++; # not test warnings
+$m->get_warnings;
diff --git a/t/sqlite.t b/t/sqlite.t
index bbc588d..068de22 100644
--- a/t/sqlite.t
+++ b/t/sqlite.t
@@ -1,7 +1,7 @@
use strict;
use warnings;
-use RT::Test tests => 10;
+use RT::Test;
use DBI;
use File::Temp;
use Digest::MD5;
@@ -88,4 +88,4 @@ diag "test redirect after login";
is( $m->uri, $baseurl . '/SelfService/Closed.html' );
}
-$RT::Test::Web::DESTROY++; # not test warnings
+$m->get_warnings;
commit e64fc52570675e119310cd3b9f5cd2ad2946bf57
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Fri Apr 15 13:31:30 2011 -0400
update MIRTx
diff --git a/inc/Module/Install/RTx.pm b/inc/Module/Install/RTx.pm
index f027f78..b83e279 100644
--- a/inc/Module/Install/RTx.pm
+++ b/inc/Module/Install/RTx.pm
@@ -8,7 +8,7 @@ no warnings 'once';
use Module::Install::Base;
use base 'Module::Install::Base';
-our $VERSION = '0.27';
+our $VERSION = '0.28';
use FindBin;
use File::Glob ();
@@ -44,8 +44,8 @@ sub RTx {
local @INC = (
$ENV{RTHOME} ? ( $ENV{RTHOME}, "$ENV{RTHOME}/lib" ) : (),
@INC,
- map { ( "$_/rt3/lib", "$_/lib/rt3", "$_/lib" ) } grep $_,
- @prefixes
+ map { ( "$_/rt4/lib", "$_/lib/rt4", "$_/rt3/lib", "$_/lib/rt3", "$_/lib" )
+ } grep $_, @prefixes
);
until ( eval { require RT; $RT::LocalPath } ) {
warn
@@ -186,8 +186,46 @@ sub RTxInit {
die "Cannot load RT" unless $RT::Handle and $RT::DatabaseType;
}
+# stolen from RT::Handle so we work on 3.6 (cmp_versions came in with 3.8)
+{ my %word = (
+ a => -4,
+ alpha => -4,
+ b => -3,
+ beta => -3,
+ pre => -2,
+ rc => -1,
+ head => 9999,
+);
+sub cmp_version($$) {
+ my ($a, $b) = (@_);
+ my @a = grep defined, map { /^[0-9]+$/? $_ : /^[a-zA-Z]+$/? $word{$_}|| -10 : undef }
+ split /([^0-9]+)/, $a;
+ my @b = grep defined, map { /^[0-9]+$/? $_ : /^[a-zA-Z]+$/? $word{$_}|| -10 : undef }
+ split /([^0-9]+)/, $b;
+ @a > @b
+ ? push @b, (0) x (@a- at b)
+ : push @a, (0) x (@b- at a);
+ for ( my $i = 0; $i < @a; $i++ ) {
+ return $a[$i] <=> $b[$i] if $a[$i] <=> $b[$i];
+ }
+ return 0;
+}}
+sub requires_rt {
+ my ($self,$version) = @_;
+
+ # if we're exactly the same version as what we want, silently return
+ return if ($version eq $RT::VERSION);
+
+ my @sorted = sort cmp_version $version,$RT::VERSION;
+
+ if ($sorted[-1] eq $version) {
+ # should we die?
+ warn "\nWarning: prerequisite RT $version not found. Your installed version of RT ($RT::VERSION) is too old.\n\n";
+ }
+}
+
1;
__END__
-#line 304
+#line 348
commit 5b2dd390adf82c456f8feaddfbd98c2787bf7e8c
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Fri Apr 15 13:34:32 2011 -0400
Make these author tests for now until we're sure they won't hurt people
People tend to install from the cpan shell and RT::Test expects
environment variables and a live DB to test on.
diff --git a/META.yml b/META.yml
index 4e7aa56..0ae0fed 100644
--- a/META.yml
+++ b/META.yml
@@ -18,6 +18,7 @@ no_index:
- etc
- html
- inc
+ - xt
recommends:
CGI::Cookie: 0
DBI: 0
diff --git a/Makefile.PL b/Makefile.PL
index 3a60f7a..886b02a 100755
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -27,6 +27,8 @@ feature 'SSO Cookie Sources' =>
recommends('CGI::Cookie' => 0),
;
+author_tests('xt');
+
&auto_install();
&WriteAll;
diff --git a/inc/Module/Install/AuthorTests.pm b/inc/Module/Install/AuthorTests.pm
new file mode 100644
index 0000000..c44931b
--- /dev/null
+++ b/inc/Module/Install/AuthorTests.pm
@@ -0,0 +1,59 @@
+#line 1
+package Module::Install::AuthorTests;
+
+use 5.005;
+use strict;
+use Module::Install::Base;
+use Carp ();
+
+#line 16
+
+use vars qw{$VERSION $ISCORE @ISA};
+BEGIN {
+ $VERSION = '0.002';
+ $ISCORE = 1;
+ @ISA = qw{Module::Install::Base};
+}
+
+#line 42
+
+sub author_tests {
+ my ($self, @dirs) = @_;
+ _add_author_tests($self, \@dirs, 0);
+}
+
+#line 56
+
+sub recursive_author_tests {
+ my ($self, @dirs) = @_;
+ _add_author_tests($self, \@dirs, 1);
+}
+
+sub _wanted {
+ my $href = shift;
+ sub { /\.t$/ and -f $_ and $href->{$File::Find::dir} = 1 }
+}
+
+sub _add_author_tests {
+ my ($self, $dirs, $recurse) = @_;
+ return unless $Module::Install::AUTHOR;
+
+ my @tests = $self->tests ? (split / /, $self->tests) : 't/*.t';
+
+ # XXX: pick a default, later -- rjbs, 2008-02-24
+ my @dirs = @$dirs ? @$dirs : Carp::confess "no dirs given to author_tests";
+ @dirs = grep { -d } @dirs;
+
+ if ($recurse) {
+ require File::Find;
+ my %test_dir;
+ File::Find::find(_wanted(\%test_dir), @dirs);
+ $self->tests( join ' ', @tests, map { "$_/*.t" } sort keys %test_dir );
+ } else {
+ $self->tests( join ' ', @tests, map { "$_/*.t" } sort @dirs );
+ }
+}
+
+#line 107
+
+1;
diff --git a/t/ldap.t b/xt/ldap.t
similarity index 100%
rename from t/ldap.t
rename to xt/ldap.t
diff --git a/t/ldap_privileged.t b/xt/ldap_privileged.t
similarity index 100%
rename from t/ldap_privileged.t
rename to xt/ldap_privileged.t
diff --git a/t/sqlite.t b/xt/sqlite.t
similarity index 100%
rename from t/sqlite.t
rename to xt/sqlite.t
commit e5fd331d03829d5171a240d8f46e3fd5b6edba07
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Fri Apr 15 13:47:12 2011 -0400
ignore my editor
diff --git a/.gitignore b/.gitignore
index ffabd7e..432eb4a 100644
--- a/.gitignore
+++ b/.gitignore
@@ -2,3 +2,4 @@ Makefile
blib
pm_to_blib
MANIFEST.bak
+*.swp
commit 3862b7ca26bdcdce5b03af01071d9a30ea252cc4
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Fri Apr 15 13:53:32 2011 -0400
While we're cleaning things, kill this 3.8.1 compatibility code
Require 3.8.2 or higher in the makefile
Older users should use 0.08, we'll leave it on CPAN
Document what to use on older things
Document how to upgrade and avoid modification of a read-only variable bug
diff --git a/Makefile.PL b/Makefile.PL
index 886b02a..4e55763 100755
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -29,6 +29,8 @@ feature 'SSO Cookie Sources' =>
author_tests('xt');
+requires_rt('3.8.2');
+
&auto_install();
&WriteAll;
diff --git a/README b/README
index 79031b0..d185556 100644
--- a/README
+++ b/README
@@ -1,5 +1,27 @@
RT-Authen-ExternalAuth
+=========================
+Important Upgrading Notes:
+=========================
+
+If you are upgrading from an earlier version of this extension, you must
+remove the following file manually:
+
+ rm /opt/rt3/local/plugins/RT-Authen-ExternalAuth/lib/RT/User_Vendor.pm
+
+Otherwise you will most likely encounter an error about modifying a read
+only value and be unable to start RT.
+
+=========================
+Import Installation Notes:
+=========================
+
+If you are using RT 3.6, you want to use the 0.05 version.
+If you are using RT 3.8.0 or 3.8.1, you may have trouble installing this
+due to RT bugs related to plugins, but you may be able to use 0.08.
+Later versions of this module will not work on 3.8.0 or 3.8.1.
+
+
This module provides the ability to authenticate RT users
against one or more external data sources at once. It will
also allow information about that user to be loaded from
diff --git a/html/Elements/DoAuth b/html/Elements/DoAuth
index a0eea8d..0be9cc2 100644
--- a/html/Elements/DoAuth
+++ b/html/Elements/DoAuth
@@ -5,21 +5,6 @@ my $loaded_user = 0;
use RT::Authen::ExternalAuth;
-###################################################################################
-# Work around a bug in the RT 3.8.0 and 3.8.1 plugin system (fixed in 3.8.2) #
-# Temporarily force RT to reload RT::User, since it isn't being loaded #
-# correctly as a plugin. #
-###################################################################################
-unless ($loaded_user) {
- $RT::Logger->debug("Reloading RT::User to work around a bug in RT-3.8.0 and RT-3.8.1");
- $loaded_user++;
- delete $INC{'RT/User.pm'};
- delete $INC{'RT/User_Overlay.pm'};
- delete $INC{'RT/User_Vendor.pm'};
- require RT::User;
-}
-###################################################################################
-
my ($val,$msg);
unless($session{'CurrentUser'} && $session{'CurrentUser'}->Id) {
($val,$msg) = RT::Authen::ExternalAuth::DoAuth(\%session,$user,$pass);
commit 6e49fc1d0523ed201336b47fdb9f4ba547cd7a2d
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Fri Apr 15 14:32:27 2011 -0400
Fix up the manifest and ignore some generated files
diff --git a/.gitignore b/.gitignore
index 432eb4a..b0afdd4 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,4 +1,5 @@
Makefile
+Makefile.old
blib
pm_to_blib
MANIFEST.bak
diff --git a/MANIFEST b/MANIFEST
index 91224d6..470729e 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -6,6 +6,7 @@ html/Callbacks/ExternalAuth/Elements/Header/Head
html/Elements/DoAuth
inc/Module/AutoInstall.pm
inc/Module/Install.pm
+inc/Module/Install/AuthorTests.pm
inc/Module/Install/AutoInstall.pm
inc/Module/Install/Base.pm
inc/Module/Install/Can.pm
@@ -20,9 +21,11 @@ lib/RT/Authen/ExternalAuth.pm
lib/RT/Authen/ExternalAuth/DBI.pm
lib/RT/Authen/ExternalAuth/DBI/Cookie.pm
lib/RT/Authen/ExternalAuth/LDAP.pm
-lib/RT/User_Vendor.pm
LICENSE
Makefile.PL
MANIFEST This list of files
META.yml
README
+xt/ldap.t
+xt/ldap_privileged.t
+xt/sqlite.t
commit 222c6866b49efd54e229676cfe0491a3e53cce54
Author: Thomas Sibley <trs at bestpractical.com>
Date: Fri Apr 15 14:42:04 2011 -0400
Fix a minor logic nit that makes the code slightly cleaner
Since we do $next || WebURL, we don't need to redirect only if $next is
true. Technically we don't need to default to WebURL ourselves at all
since requesting /NoAuth/Login.html as a logged in user will get you
bounced to WebURL (in RT::Interface::Web::MaybeShowNoAuthPage).
diff --git a/html/Callbacks/ExternalAuth/autohandler/Session b/html/Callbacks/ExternalAuth/autohandler/Session
index ceffb6b..e8ef014 100644
--- a/html/Callbacks/ExternalAuth/autohandler/Session
+++ b/html/Callbacks/ExternalAuth/autohandler/Session
@@ -7,8 +7,6 @@ if ( $m->request_comp->path eq '/NoAuth/Login.html'
&& $ARGS{next} )
{
my $next = delete $session{'NextPage'}->{ $ARGS{'next'} };
- if ($next) {
- RT::Interface::Web::Redirect( $next || RT->Config->Get('WebURL') );
- }
+ RT::Interface::Web::Redirect( $next || RT->Config->Get('WebURL') );
}
</%init>
commit 544eb193bac64c5d8a9aea1db4e808325cc51d3b
Author: Thomas Sibley <trs at bestpractical.com>
Date: Fri Apr 15 14:43:52 2011 -0400
Ensure that logging in using query params works with ExternalAuth
diff --git a/xt/sqlite.t b/xt/sqlite.t
index 068de22..c3d6ac0 100644
--- a/xt/sqlite.t
+++ b/xt/sqlite.t
@@ -88,4 +88,12 @@ diag "test redirect after login";
is( $m->uri, $baseurl . '/SelfService/Closed.html' );
}
+diag "test with user and pass in URL";
+{
+ $m->logout;
+ $m->get_ok( $baseurl . '/SelfService/Closed.html?user=testuser;pass=password', 'closed tickets page' );
+ $m->text_contains( 'Logout', 'logged in' );
+ is( $m->uri, $baseurl . '/SelfService/Closed.html?user=testuser;pass=password' );
+}
+
$m->get_warnings;
commit bb4de0120d232e7c9cae1dbbdb40bbde55016833
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Fri Apr 15 15:16:13 2011 -0400
Make sure canonicalization works
diff --git a/xt/sqlite.t b/xt/sqlite.t
index c3d6ac0..09791de 100644
--- a/xt/sqlite.t
+++ b/xt/sqlite.t
@@ -63,6 +63,15 @@ diag "test uri login";
ok( !$m->login( 'testuser', 'wrongpassword' ), 'not logged in with wrong password' );
ok( $m->login( 'testuser', 'password' ), 'logged in' );
}
+
+diag "test user creation";
+{
+my $testuser = RT::User->new($RT::SystemUser);
+my ($ok,$msg) = $testuser->Load( 'testuser' );
+ok($ok,$msg);
+is($testuser->EmailAddress,'testuser at invalid.tld');
+}
+
diag "test form login";
{
$m->logout;
commit 13c21f23f22ddd02a3ffc882b2acb567b7494912
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Fri Apr 15 15:27:30 2011 -0400
When I removed the 3.8.0 and 3.8.1 workaround, CanonicalizeUserInfo
started running again
Before this, we weren't fetching external data from ldap or sql after
the auth. This was spotted because the tests started failing (auth
worked but we couldn't create the user because it couldn't retrieve user
info for Create).
Defined an Info action to run.
apply some ldap screwing around so that filter is right and the
attributes line up and then try to forget how it all works.
diff --git a/xt/ldap.t b/xt/ldap.t
index a974597..821afaa 100644
--- a/xt/ldap.t
+++ b/xt/ldap.t
@@ -29,6 +29,7 @@ $ldap->add( $dn, attr => [%$entry] );
RT->Config->Set( Plugins => 'RT::Authen::ExternalAuth' );
RT->Config->Set( ExternalAuthPriority => ['My_LDAP'] );
+RT->Config->Set( ExternalInfoPriority => ['My_LDAP'] );
RT->Config->Set( ExternalServiceUsesSSLorTLS => 0 );
RT->Config->Set( AutoCreateNonExternalUsers => 0 );
RT->Config->Set( AutoCreate => undef );
@@ -38,11 +39,11 @@ RT->Config->Set(
'type' => 'ldap',
'server' => "127.0.0.1:$ldap_port",
'base' => 'dc=bestpractical,dc=com',
- 'filter' => '()',
- 'd_filter' => '(objectClass=*)',
+ 'filter' => '(objectClass=*)',
+ 'd_filter' => '()',
'tls' => 0,
'net_ldap_args' => [ version => 3 ],
- 'attr_match_list' => [ 'uid', 'EmailAddress' ],
+ 'attr_match_list' => [ 'Name', 'EmailAddress' ],
'attr_map' => {
'Name' => 'uid',
'EmailAddress' => 'mail',
diff --git a/xt/ldap_privileged.t b/xt/ldap_privileged.t
index c6c5f65..a5eff51 100644
--- a/xt/ldap_privileged.t
+++ b/xt/ldap_privileged.t
@@ -28,6 +28,7 @@ $ldap->add( $dn, attr => [%$entry] );
RT->Config->Set( Plugins => 'RT::Authen::ExternalAuth' );
RT->Config->Set( ExternalAuthPriority => ['My_LDAP'] );
+RT->Config->Set( ExternalInfoPriority => ['My_LDAP'] );
RT->Config->Set( ExternalServiceUsesSSLorTLS => 0 );
RT->Config->Set( AutoCreateNonExternalUsers => 0 );
RT->Config->Set( AutoCreate => { Privileged => 1 } );
@@ -37,11 +38,10 @@ RT->Config->Set(
'type' => 'ldap',
'server' => "127.0.0.1:$ldap_port",
'base' => 'dc=bestpractical,dc=com',
- 'filter' => '()',
- 'd_filter' => '(objectClass=*)',
+ 'filter' => '(objectClass=*)',
'tls' => 0,
'net_ldap_args' => [ version => 3 ],
- 'attr_match_list' => [ 'uid', 'EmailAddress' ],
+ 'attr_match_list' => [ 'Name', 'EmailAddress' ],
'attr_map' => {
'Name' => 'uid',
'EmailAddress' => 'mail',
commit f55462bd6c19867c2f090cb34028797b27a2cb7e
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Fri Apr 15 15:30:28 2011 -0400
Add tests to ensure that EmailAddress is yanked from ldap
diff --git a/xt/ldap.t b/xt/ldap.t
index 821afaa..89b9203 100644
--- a/xt/ldap.t
+++ b/xt/ldap.t
@@ -59,6 +59,14 @@ diag "test uri login";
ok( !$m->login( 'fakeuser', 'password' ), 'not logged in with fake user' );
ok( $m->login( 'testuser', 'password' ), 'logged in' );
}
+diag "test user creation";
+{
+my $testuser = RT::User->new($RT::SystemUser);
+my ($ok,$msg) = $testuser->Load( 'testuser' );
+ok($ok,$msg);
+is($testuser->EmailAddress,'testuser at invalid.tld');
+}
+
diag "test form login";
{
diff --git a/xt/ldap_privileged.t b/xt/ldap_privileged.t
index a5eff51..770cea8 100644
--- a/xt/ldap_privileged.t
+++ b/xt/ldap_privileged.t
@@ -58,6 +58,15 @@ diag "test uri login";
ok( $m->login( 'testuser', 'password' ), 'logged in' );
}
+diag "test user creation";
+{
+my $testuser = RT::User->new($RT::SystemUser);
+my ($ok,$msg) = $testuser->Load( 'testuser' );
+ok($ok,$msg);
+is($testuser->EmailAddress,'testuser at invalid.tld');
+}
+
+
diag "test form login";
{
$m->logout;
commit 03f633d0be7595ca49a321d28437c608f63e7fad
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Fri Apr 15 15:41:46 2011 -0400
Bump version for a bugfix release
diff --git a/META.yml b/META.yml
index 0ae0fed..8335764 100644
--- a/META.yml
+++ b/META.yml
@@ -18,6 +18,7 @@ no_index:
- etc
- html
- inc
+ - t
- xt
recommends:
CGI::Cookie: 0
@@ -31,4 +32,4 @@ requires:
Net::SSLeay: 0
resources:
license: http://opensource.org/licenses/gpl-license.php
-version: 0.08_01
+version: 0.08_02
diff --git a/lib/RT/Authen/ExternalAuth.pm b/lib/RT/Authen/ExternalAuth.pm
index c36715e..8f3d339 100644
--- a/lib/RT/Authen/ExternalAuth.pm
+++ b/lib/RT/Authen/ExternalAuth.pm
@@ -1,6 +1,6 @@
package RT::Authen::ExternalAuth;
-our $VERSION = '0.08_01';
+our $VERSION = '0.08_02';
=head1 NAME
-----------------------------------------------------------------------
More information about the Bps-public-commit
mailing list