Apache-DBI-1.12/000755 000765 000765 00000000000 12156021310 013461 5ustar00phredphred000000 000000 Apache-DBI-1.12/Changes000644 000765 000765 00000044100 12156021100 014750 0ustar00phredphred000000 000000 Revision history for ApacheDBI. 1.12 June 12, 2013 - Fix detection of server startup in mod_perl 2, to avoid caching connections in the parent process. Perrin Harkins 1.11 October 7, 2011 - RT 69087, Perl 5.14 'Using qw(...) as parentheses' fix 1.10 February 2, 2011 - Add Apache2::RequestUtil for mp2 instances. Issue reported by wanradt@gmail.com [Fred Moyer 1.09 November 11, 2010 - Fix pod errors Submitted by: Damyan Ivanov - Adds PerlChildExitHandler to disconnect existing connections Submitted by: Nick Wellnhoffer 1.08 February 3rd, 2010 - Fix bug to allow DBI in startup.pl etc again Bug report from Adam Prime, patch from Lubomir Rintel https://rt.cpan.org/Public/Bug/Display.html?id=36346 1.07 05/09/2008 - http://rt.cpan.org/Public/Bug/Display.html?id=31003 Submitted by: diafour@gmail.com Tweaked by: Philip M. Gollucci - http://rt.cpan.org/Public/Bug/Display.html?id=29209 PerlCleanupHandler doesn't get called with MP2 Submitted by: nick.aevum.de - http://rt.cpan.org/Public/Bug/Display.html?id=28824 Documentation Additions Submitted by: [Perrin Harkins ] 1.06 03/23/2007 - MP2/AuthDBI: Fixed Apache::AuthDBI::debug() to actually work. Submitted by: [Kevin Appel ] - Bump minium required perl version to 5.6.1 to match DBI (Changes in DBI 1.49 (svn rev 2287), 29th November 2005) Philip M. Gollucci 1.05 11/3/2006 - MP2/AuthDBI: Add missing Apache2::Access Submitted by: Adam Prime x443 1.04 10/23/2006 - MP1: Undefined subroutine &Apache2::Const::OK called at .... (The rest of them) d'oh! Seconded by: Kjetil Kjernsmo Submitted by: BOWMANBS 1.03 08/21/2006 - MP1: Undefined subroutine &Apache2::Const::OK called at Apache/AuthDBI.pm line 906. Submitted by: [Philip.Garrett@manheim.com] Reviewed by: Kevin A. McGrail (ThoughtWorthy Media, Inc.) - http://rt.cpan.org/Ticket/Display.html?id=20809 avoid a warnings caused by debug statements Reported by: Vladimir S. Tikhonjuk 1.02 08/02/2006 - http://rt.cpan.org/Ticket/Display.html?id=20808 s/denug/debug/ typo in Apache::AuthDBI Submitted by: Vladimir S. Tikhonjuk 1.01 06/04/2006 - Re-release as non developer release. No changes from 1.00_01. [Philip M. Gollucci ] 1.00_01 05/29/2006 - As DBI has supported only perl 5.6.0 since 2003 v1.38 Apache::DBI now requires perl 5.6.0 as well. [Philip M. Gollucci ] - Fix a plethora of uninitialized variable warnings, general code cleanup, don't import unneeded symbols from Carp, Digest::SHA1, and Digest::MD5 [Philip M. Gollucci ] - http://rt.cpan.org/Ticket/Display.html?id=17073 $sth->rows is inconsistent across DBD::* drivers and sometimes always returns 0. We were using this to distinguish between a blank password and no passwd. Now we don't call this function. Reported by: rkimmelmann@web.de [Philip M. Gollucci ] - http://rt.cpan.org/Ticket/Display.html?id=17422 a fatal error involving mp1, mp2 constants co-existance was fixed in AuthDBI. [Philip M. Gollucci ] - http://rt.cpan.org/Ticket/Display.html?id=17446 under mod_perl 2, the check to skip caching connections at server startup was broken; thus, causing children to incorrectly share dbh handles with the parent. Submitted by: clinton@traveljury.com - http://rt.cpan.org/Ticket/Display.html?id=19491 a critical return was missing connect() under mod_perl2 Submitted by: perrin@elem.com - Moved module's repository to its new home in SVN from CVS http://svn.perl.org/modules/Apache-DBI [Philip M. Gollucci ] 0.9901 08/19/2005 - Fix the versioning blunder of .100 < .99 [Philip M. Gollucci ] - Account for the case of mp1 and mp2 installed in the same perl tree. The evals were not playing nice with modules like Apache::SSI, Apache::SessionManager. Sumitted by: [Frank Maas ] Tweaked/reviewed by: [Philip M. Gollucci ] 0.100 08/10/2005 - Move $Idx from a file-scoped variable to a connect() scoped variable, which gets passed to other subroutines as needed. This will ensure that the cleanup/rollback feature will work properly when a script uses more than one database handle to the same database. [Joe Thomas ] - Fixed issues relating to changing handle state post connection. Handles now returned in same state as original and incomplete transactions rolled back before re-issuing handle so. Submited by: [Joe Thomas ] Contributed by: [Patrick Mulvany ] - Fix a () bug in the connect() determining whether we must ping the database. PingTimeOut = 0 now works as documented. Submited by: [Joe Thomas ] Contributed by: [Patrick Mulvany ] 0.99 08/03/2005 - Turn off Debugging by default. Reported by [Philip M. Gollucci ] 0.98 06/30/2005 - Fix MP2 issue with $Apache::Server::Starting Reported by Vincent Moneymaker vbmonymaker@hotmail.com [Philip M. Gollucci ] 0.97 06/27/2005 - Fix minor use strict bug in make test [Philip M. Gollucci ] - Fixed a bug in salt calculation Kevin A. McGrail (ThoughtWorthy Media, Inc.) - Added Auth_DBI_encryption_method configuration. Supports md5 hex, sha1 hex & crypt and will support fallback. Other encryption methods can be added by modifying the subroutine get_passwds_to_check Kevin A. McGrail (ThoughtWorthy Media, Inc.) - MP2/MP1 Constants compatability fixes in AuthDBI Kevin A. McGrail (ThoughtWorthy Media, Inc.) - Added a feature 'Apache::AuthDBI->setProjID(1)' to set a Shared Memory Project ID when using the shared memory caching. Kevin A. McGrail (ThoughtWorthy Media, Inc.) - Fixed an MP2 problem when Debug is set to 2 changing is_main() to main() call Kevin A. McGrail (ThoughtWorthy Media, Inc.) - Added a few more Debug statements including the Semaphore ID in hex to use ipcs Kevin A. McGrail (ThoughtWorthy Media, Inc.) 0.96 04/19/2005 - Account for the recent mod_perl2 API renaming [Philip M .Gollucci ] 0.95 04/01/2005 - Avoid "The object isn't defined" error during "make test" if we can't connect to the test database. 0.94 February 17, 2004 - Fix use of uninitialized value warnings when passed an "undef" attribute (thanks to Trevor Schellhorn) - Minor POD cleanups 0.93 January 10, 2004 - Always check $dbh->ping if the PingTimeOut is 0. (thanks to Dennis Ingram ) - Change $r->connection->user to $r->user to make AuthDBI work with mod_perl 2.0 (thanks to Neil MacGregor and Brian McCauley ) - removes the requirement for IPC::SysV to be installed if you don't actually use it. Remove support for mod_perls without push_handler support (Thanks to Brian again) - improve tests (based on patch from Geoffrey Young ; thanks Geoff!) 0.92 August 11, 2003 - Avoid use of uninitialized value warning under mod_perl 2. - Make the tests compatible with DBI >= 1.33 (thanks to Paul MacAdam ) 0.91 February 17, 2003 - Retagged and released the 0.90_02 beta as 0.91. No code changes. 0.90_02 January 10, 2003 - Changes to make Apache::DBI load and function under mod_perl 2.0. A few important notes: connect_on_init does not work yet and there's no automatic RollBack cleanup handler when autocommit is turned off. 0.90_01 January 10, 2003 - Only call Apache::Status if Apache.pm is completely loaded (so you can load Apache::DBI outside the mod_perl environment) - Make Test::More a prerequisite so we can do real tests - Make DBI.pm a prerequisite - Add a simple, but real, test script. Requires DBD::mysql and a test database 0.89 June 17, 2002 - fix bug that occasionally made Apache::DBI connect several times to the database even when DSN and attributes were the same. - Updated links and such in the documentation 0.88 January 12, 2001 - fix bug in child_init: consider 0 as valid result for a semaphore id. - remove defined(@array), which is depreceated in perl5.6 0.87 September 28, 1999 - fix for the usage of the environment variable DBI_DSN introduced in 0.86 was still incomplete. 0.86 September 27, 1999 - in AuthDBI remove check of configured data_source in order to allow the usage of the environment variable DBI_DSN. Bug spotted by Oleg Bartunov . - applied patch from Matt Loschert , which avoids 'Use of uninitialized value ...' in Apache::DBI. - added new attribute 'Auth_DBI_encryption_salt' as proposed by Nathan Clemons . Per default this is set to 'password' which will use the password as salt for the crypt function. Setting this to 'userid' will use the userid as salt. - fixed bug with setting Auth_DBI_nopasswd to 'on', spotted by "Sigurjon Olafsson" . 0.85 August 24, 1999 - change separator of Auth_DBI_data_source, Auth_DBI_username and Auth_DBI_password from comma to tilde, in order to avoid clashes with embedded attributes in data_source. Bug spotted by Oleg Bartunov . - applied patch to Apache::DBI.pm from Tim Bunce which solves the problem that Apache::DBI did not return a ref cursor. 0.84 August 21, 1999 - combine Apache::AuthenDBI and Apache::AuthzDBI into one package Apache::AuthDBI. - discard Apache::DebugDBI. Debugging can be enabled by setting the variables Apache::AuthDBI::DEBUG and Apache::DBI::DEBUG to appropriate values. - the attribute 'Auth_DBI_cache_time' has been discarded. The cache time now has to be configured upon server startup using the method setCacheTime(n). - optionally use shared memory for the cache used for authentication and authorization as proposed by Rauznitz Balazs . - make the PerlCleanupHandler, which cleans the cache in Apache::AuthDBI, configurable. Per default it is switched off. - connect attributes for authentication and authorization may be a list of several servers, all of which will be used until the first connect succeeds. Proposed by Matt Loschert . - the PerlCleanupHandler in Apache::DBI.pm, which is supposed to initiate a rollback in case AutoCommit is off, will only be created, if the initial data_source sets AutoCommit to 0. - fixed bug with empty password, which didn't fall through for authoritative = off, spotted by "Graham Johnson" . - analogous to the environment variables REMOTE_GROUPS and REMOTE_GROUP the selected passwords and the matched password are put into the environment variables REMOTE_PASSWORDS and REMOTE_PASSWORD. Proposed by Jochen Wiedmann . - add traces.txt, which serves as reference for the debug output. 0.83 August 08, 1999 - make ping configurable, proposed by Gunther Birznieks - change $user_sent_quoted to $user_sent when checking for placeholders (Michael Smith ) - bug-fix for encrypted passwords, which have never been taken from the cache. Spotted by Yves BLUSSEAU . 0.82 June 03, 1999 - bug-fix spotted by "Dale Manemann" : correct the password handling for the case, where the password has been changed in the database and the old password is still cached. - proposal from Honza Pazdziora : add PerlCleanupHandler in Apache::DBI, which issues a rollback unless AutoCommit is on. - changed behavior of AuthzDBI: the first match of a requirement is sufficient for successful authorization. Prior to this release, all requirement lines had to be fulfilled. - proposal from Rauznitz Balazs : new function all_handlers() in Apache::DBI.pm. Returns all cached database handles, so that other handlers can perform tasks on them. - proposal from Michael Smith : new configuration option Auth_DBI_placeholder. Setting this option to true, will use placeholders for the given userid in the SELECT statements. This will speedup database access. - proposal from "Jordi 'Matematic' Salvat" : replace AuthName with a summary of all attributes relevant for the select statements. This still keeps the userid entries in the cache unique, but solves the problem with different AuthNames which eventually forces the user to authenticate several times. - new configuration option Auth_DBI_expeditive from "Jordi 'Matematic' Salvat" . When authorization fails, AuthzDBI returns AUTH_REQUIRED as default. With Auth_DBI_expeditive set to "on" it returns FORBIDDEN if access is denied. Hence this can be distinguished from the case, where the user just mistyped the password. - applied patch from Ask Bjoern Hansen : get rid of some annoying "Use of uninitialized value ..." - applied patch from Joshua Chamas : use eval{ping} to prevent using an invalid database handle. - added 'use Apache;' to Apache::DBI.pm as proposed by Michael Smith . - implemented multiple passwords per userid as proposed by dan hammer . - applied patch for case-insensitive user-ids from . - implement proposal from Honza Pazdziora : Auth_DBI_casesensitive replaced by Auth_DBI_uidcasesensitive and Auth_DBI_pwdcasesensitive. - applied patch from fdc@cliwe.ping.de (Frank D. Cringle): prevent "Use of uninitialized value warning" in error.log. - work-around for mod_perl problem spotted by Mike Hayward : when building mod_perl as dso, Apache::DBI was always skipping the connection cache. 0.81 Sep 08, 1998 - Cache entries consider the AuthName to distinguish between identical user-ids in different authorization realms. 0.80 Jul 26, 1998 - applied patch from Anto Prijosoesilo : change second argument for crypt function from $salt to $passwd in order to be compatible with BSD. - applied patch for Apache::DBI.pm from Randy Harmon : reject database connect during server startup. - call CleanupHandler in Authen DBI and AuthzDBI only if cache_time is configured. 0.79 Jun 06, 1998 - implemented a simple caching mechanism in AuthenDBI as well as in AuthzDBI. Per default this cache is disabled and can be enabled by setting Auth_DBI_cache_time > 0. YOU NEED AT LEAST VERSION apache_1.3b6 ! - applied patch from Jeff Baker fix menu item for DBI connections that are made using the Oracle TNS listener. - implemented proposal from Leslie Mikesell change group-handling in AuthzDBI. All groups related to the given user are selected at once and then put into a comma-separated list. This list is compared with the required groups. Depending upon the existence of Auth_DBI_grp_table, the SQL-select looks either in the pwd_table or in the grp_table for the groupid. PLEASE CHECK THE MODULE DOCUMENTATION AND YOUR .htaccess ! 0.78 February 18, 1998 - applied patch from "B. W. Fitzpatrick" DBI calls connect always with 4 parameters, even if they are empty. This results in an error with DBD-Informix. - added '$dbh->disconnect' before 'return SERVER_ERROR;' (fyodor@mp.aha.ru ). - added optional where-clause in AuthenDBI as well as in AuthzDBI (Helmut Patay ). 0.77 January 18, 1998 - applied patches from Doug MacEachern: o new method Apache::DBI->connect_on_init() o set environment variable REMOTE_GROUP in AuthzDBI.pm. 0.76 December 18, 1997 - removed unused variable from AuthzDBI.pm 0.75 November 02, 1997 - strip trailing blanks from password for fixed-length data type - new token: 'Auth_DBI_casesensitive' fixed bug when using attributes in connect method fixed bug which appeared with perl5.004_04 (Hakan Tandogan 0.74 August 15, 1997 - new module: AuthzDBI for Authorization, (supports group authorization) - complete rewrite of AuthenDBI. - configuration directives and functionality of both modules are supposed to be identical with mod_auth_msql of the apache daemon. - adapted to new DBI connect syntax - changed names of config vars to be more consistent with other authentication modules. PLEASE ADAPT YOUR CONFIGURATION !!! 0.73 July 15, 1997 - fixed bug in DBI.pm: check return value of connect 0.72 July 13, 1997 - added logging option to AuthenDBI 0.71 July 01, 1997 - debugging is now controlled by a global variable 0.7 July 01, 1997 - changed the way of initiating debug output 0.6 May 20, 1997 - fixed bug which caused a disconnect with some DBD-drivers (Oracle,...) 0.5 May 16, 1997 - applied patches from Stephen E Kane 0.4 May 13, 1997 - fixed check for first internal request in AuthenDBI.pm 0.3 May 5, 1997 - make AuthenDBI to be a separate module - adapt to new DBI, so code changes are not required anymore for persistent connections 0.2 Apr 6, 1997 - unused methods deleted - AuthenDBI integrated - method for disconnect added - menu item for Apache::Status added 0.1 Mar 15, 1997 - creation Apache-DBI-1.12/eg/000755 000765 000765 00000000000 12156021310 014054 5ustar00phredphred000000 000000 Apache-DBI-1.12/lib/000755 000765 000765 00000000000 12156021310 014227 5ustar00phredphred000000 000000 Apache-DBI-1.12/Makefile.PL000644 000765 000765 00000000703 12156020711 015437 0ustar00phredphred000000 000000 use ExtUtils::MakeMaker; WriteMakefile( 'NAME' => 'Apache::DBI', 'VERSION_FROM' => 'lib/Apache/DBI.pm', 'PREREQ_PM' => { 'Test::More' => 0, # without tests we don't know fun. 'DBI' => 1.00, # no DBI can never be any fun. 'Digest::SHA1' => 2.01, # SHA1 Digest for alternate encryption method fun. 'Digest::MD5' => 2.20 # MD5 Digest for even more fun. }, ); # EOF Apache-DBI-1.12/MANIFEST000644 000765 000765 00000000436 12156021310 014615 0ustar00phredphred000000 000000 Changes MANIFEST Makefile.PL README TODO eg/startup.pl lib/Apache/AuthDBI.pm lib/Apache/DBI.pm t/10mysql.t traces.txt META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Apache-DBI-1.12/META.json000644 000765 000765 00000001640 12156021310 015103 0ustar00phredphred000000 000000 { "abstract" : "unknown", "author" : [ "unknown" ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.6302, CPAN::Meta::Converter version 2.120630", "license" : [ "unknown" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Apache-DBI", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "DBI" : "1", "Digest::MD5" : "2.2", "Digest::SHA1" : "2.01", "Test::More" : "0" } } }, "release_status" : "stable", "version" : "1.12" } Apache-DBI-1.12/META.yml000644 000765 000765 00000000752 12156021310 014736 0ustar00phredphred000000 000000 --- abstract: unknown author: - unknown build_requires: ExtUtils::MakeMaker: 0 configure_requires: ExtUtils::MakeMaker: 0 dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.6302, CPAN::Meta::Converter version 2.120630' license: unknown meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Apache-DBI no_index: directory: - t - inc requires: DBI: 1 Digest::MD5: 2.2 Digest::SHA1: 2.01 Test::More: 0 version: 1.12 Apache-DBI-1.12/README000644 000765 000765 00000026303 12156021205 014350 0ustar00phredphred000000 000000 DESCRIPTION: ------------ This is version 1.12 of Apache::AuthDBI and Apache::DBI. These modules are supposed to be used with the Apache server together with an embedded perl interpreter like mod_perl. They provide support for basic authentication and authorization as well as support for persistent database connections via Perl's Database Independent Interface (DBI). o DBI.pm provides persistent database connections: - connections can be established during server-startup - configurable rollback to ensure data integrity - configurable verification of the connections to avoid time-outs. o AuthDBI.pm provides authentication and authorization: - optional shared cache for passwords to minimize database load - configurable cleanup-handler deletes outdated entries from the cache Apache::DBI has been in widespread deployment on many platforms for years. Apache::DBI is one of the most widely used mod_perl related modules. It can be considered stable. RECENT CHANGES: --------------- See the Changes file for more detail DEVELOPMENT: ------------ Apache::DBI is in svn at perl.org; see http://svn.perl.org/modules/Apache-DBI EXAMPLES: --------- Here we explain only some simple examples. For further information and limitations please read the module documentation. 1. user authentication Suppose you want to restrict access to a certain URL to a specific user and the necessary information for restricting user access is stored in your database. A typical setup would be the following: conf/httpd.conf: PerlModule Apache::AuthDBI URL/.htaccess: AuthName DBI AuthType Basic PerlAuthenHandler Apache::AuthDBI::authen PerlSetVar Auth_DBI_data_source dbi:driver:dsn PerlSetVar Auth_DBI_username db_username PerlSetVar Auth_DBI_password db_password # DBI->connect($data_source, $username, $password) PerlSetVar Auth_DBI_pwd_table users PerlSetVar Auth_DBI_uid_field username PerlSetVar Auth_DBI_pwd_field password #SELECT pwd_field FROM pwd_table WHERE uid_field=$user require user myuser In this example it is assumed, that your database contains a table named 'users' which has at least the two columns 'username' and 'password'. When accessing the URL for the first time a requester pops up, asking for username and password. For authentication the module retrieves for the given username the password from the database. This is compared with the crypted password given by the user. If the check succeeds, the user is given access to the specified URL. Please do not confuse this user authentication with the username/password needed for the database connect. These two authentications are completely independent ! Windows users should turn off the case-sensitive option. 2. group authorization Suppose you want to restrict access to a certain URL to a specific user group and the necessary information for restricting user access is stored in your database. A typical setup would be the following: conf/httpd.conf: PerlModule Apache::AuthDBI URL/.htaccess: AuthName DBI AuthType Basic PerlAuthenHandler Apache::AuthDBI::authen PerlAuthzHandler Apache::AuthDBI::authz PerlSetVar Auth_DBI_data_source dbi:mydriver:mydsn PerlSetVar Auth_DBI_username db_username PerlSetVar Auth_DBI_password db_password # DBI->connect($data_source, $username, $password) PerlSetVar Auth_DBI_pwd_table users PerlSetVar Auth_DBI_uid_field username PerlSetVar Auth_DBI_pwd_field password PerlSetVar Auth_DBI_grp_field groupname #SELECT grp_field FROM pwd_table WHERE uid_field=$user require group mygroup In this example it is assumed, that your database contains a table named 'users' which has at least the three columns 'username', 'password' and 'groupname'. When accessing the URL for the first time a requester pops up, asking for username and password. The first check (authentication) retrieves for the given username the password from the database. This is compared with the crypted password given by the user. In a second check (authorization) the groups of the given username are looked up in the database and compared with the groups required in the .htaccess file. If both checks succeed, the user is given access to the specified URL. Please do not confuse the user authentication with the username/password needed for the database connect. These two authentications are completely independent ! Although authorization handles all types of basic authentication it is perfectly sufficient to configure only authentication, as long, as the require token restricts access to 'valid-user' or to one or more single user names. You need to configure authorization only if you have more than one require token or if the require token contains one or more group names. 3. persistent database connection The following information is intended to motivate the use of persistent database connections and to explain the necessary configuration. In the above example for user authorization the requester asking for username and password pops up only once. The browser stores the user input and provides it to subsequent requests. But the sequence of two database accesses is done for every request, e.g. if your restricted URL contains a HTML page with some images, this sequence is executed once for the HTML page and once for every image ! For databases which needs a significant amount of time for the connect (e.g. start of a backend process) this might become an unacceptable overhead for the authorization procedure. This drawback can be overcome with the use of persistent database connections as provided by the Apache::DBI module. The benefit of a persistent database connection is not limited to the use of authorization. Every application, which does a lot of database queries, should gain a significant performance boost, when using persistent database connections. If you plan to use persistent database connections, there is only one thing to do: add the following configuration directive to conf/httpd.conf or to your startup.pl: PerlModule Apache::DBI # this comes first !! .... # other modules using DBI Do not change your perl scripts ! In particular do not add any 'use Apache::DBI;' statements. Also there is no need to remove the $dbh->disconnect statements from your perl scripts. The DBI module checks when it is loaded if the Apache::DBI module has been loaded before (that's the reason the Apache::DBI module has to come first). In this case, during the database connect, control flow goes through the Apache::DBI module which stores the new database handle in a global hash and which overloads the disconnect method with a do-nothing. With the above configuration every server initiates a database connection upon the first connect request. Sometimes it is more convenient to initiate all needed database handles upon process startup. This can be done with the method: Apache::DBI->connect_on_init($data_source, $username, $auth, \%attr) This method is supposed to be called in a startup file, in which also all needed modules can be loaded. As an example the file startup.pl is provided. Add all other modules you need to this file and just add one line to your httpd.conf: PerlRequire /usr/local/apache/perl/startup.pl This way all modules are pulled into the main httpd process. When the main process forks his children, the code of all modules is already in place and the database handle will also be initiated. WARNING: Do not attempt to open a persistent database connection in the parent process (via PerlRequire or PerlModule). If you do, children will get a copy of this handle, causing clashes when the handle is used by two processes at the same time. Each child must have it's own unique connection handle. For the same reason it is not possible, to share one database handle between all servers using some IPC mechanism. If you want to make sure that the module works correctly, turn on debugging as described below and search for 'Apache::DBI' in the output. You should get one 'new connect' message for every server process. Any subsequent request should result in a 'already connected' message. Please keep in mind, that server processes may be killed as well as newly created depending upon your configuration and depending upon your load. Every new server process needs to do its own initial database connect. Another useful method for enhancing the performance is to enable the caching in AuthDBI setting Auth_DBI_cache_time > 0 and to use shared memory for the cache (see the module documentation for details). This will reduce the database load considerably. COPYRIGHT: ---------- You may distribute under the terms of either the GNU General Public License or the Artistic License, as specified in the Perl README file. PREREQUISITES: -------------- Configure mod_perl1 with: perl Makefile.PL PERL_CHILD_INIT=1 PERL_AUTHEN=1 PERL_AUTHZ=1 PERL_CLEANUP=1 PERL_STACKED_HANDLERS=1 If there are no security reasons to limit the API, just use EVERYTHING=1. mod_perl2 RC5 and higher should work with Apache::DBI 0.96 and higher. No specific switches must be passed to mod_perl2's Makefile.PL. INSTALLATION: ------------- perl Makefile.PL make make test # only works with MySQL so far; patches welcome make install IF YOU HAVE PROBLEMS: --------------------- Please read the README and the the module documentation: 'perldoc Apache::AuthDBI', 'perldoc Apache::DBI'. Please verify your setup: turn on debug output and compare it to traces.txt. If you have problems with persistent database connections, verify that everything works correct without using Apache::DBI. Before sending a bug report it might be useful to look at the debug output. To enable full debug output set the following variables in startup.pl or in your perl script: $Apache::DBI::DEBUG = 2; $Apache::AuthDBI::DEBUG = 2; and watch the error_log. Compare the output to the traces in traces.txt. If this doesn't help, please send an email to and include the following information in your bug-report: - debug output, - output of perl -V, - version of ApacheDBI, - version of DBI, - used database A common problem is an error-message that $dbh will not stay shared. A complete explanation for this behavior is given in the modperl-FAQ. In short, instead of this: my $dbh = ...; subroutine(); sub subroutine { $dbh->.... } do this: my $dbh = ...; subroutine($dbh); sub subroutine { my $dbh = shift; $dbh->.... } FURTHER INFORMATION: -------------------- mod_perl by Doug MacEachern modperl-subscribe@perl.apache.org http://perl.apache.org/ DBI by Tim Bunce dbi-users-subscribe@perl.org http://dbi.perl.org/ Apache by Apache Group news:comp.infosystems.www.servers.unix users-subscribe@httpd.apache.org http://httpd.apache.org/ --------------------------------------------------------------------------- Edmund Mergl Ask Bjoern Hansen Philip M. Gollucci --------------------------------------------------------------------------- Apache-DBI-1.12/t/000755 000765 000765 00000000000 12156021310 013724 5ustar00phredphred000000 000000 Apache-DBI-1.12/TODO000644 000765 000765 00000000275 12156020711 014161 0ustar00phredphred000000 000000 Showstoppers ------------ Migrate test suite [ ?? ] Nice to have ------------ Add tests for other DBDs starting with PostgreSQL. General: ------------------------ Actually test AuthDBI Apache-DBI-1.12/traces.txt000644 000765 000765 00000027530 12156020711 015516 0ustar00phredphred000000 000000 Traces of the ApacheDBI modules The traces are supposed to serve as a reference, to check the local setup. They also serve as specification for regression testing of the modules. Note: - in order to see the traces in the error_log, you need to enable full debug output by setting $Apache::DBI::DEBUG = 2 and $Apache::AuthDBI::DEBUG = 2. - make sure, that the output of the same server is observed (check process id !) unless AuthDBI is tested and the usage of shared memory is configured. - here we show only the traces of one specific module, in reality the traces are a mix of all used modules and of all servers - in all auth-traces the REQUEST has been deleted - $; appears as '{' 1. Apache::DBI -------------- 1.1. normal persistent database connection new connect: 1150 Apache::DBI need ping: yes 1150 Apache::DBI new connect to 'dbname=template1{{{AutoCommit=1{PrintError=1' 1150 Apache::DBI disconnect (overloaded) re-use of connection: 1151 Apache::DBI need ping: yes 1151 Apache::DBI already connected to 'dbname=template1{{{AutoCommit=1{PrintError=1' 1151 Apache::DBI disconnect (overloaded) 1.2. PerlCleanupHandler: check if a rollback is initiated when using a connection with AutoCommit = 0 (data_source: dbi:Pg(AutoCommit=>0):dbname=template1): 1150 Apache::DBI push PerlCleanupHandler 1150 Apache::DBI need ping: yes 1150 Apache::DBI new connect to 'dbname=template1{{{AutoCommit=0{PrintError=1' 1150 Apache::DBI disconnect (overloaded) 1150 Apache::DBI PerlCleanupHandler 1150 Apache::DBI PerlCleanupHandler rollback for dbname=template1{{{AutoCommit=0{PrintError=1 1.3. PerlChildInitHandler: check if a pre-configured connection in startup.pl is initiated. the following entries are supposed to appear in the error_log once for every server: 1033 Apache::DBI PerlChildInitHandler 1033 Apache::DBI need ping: yes 1033 Apache::DBI new connect to 'dbname=template1{httpd{www{AutoCommit=1{PrintError=1' 1.4. timeout for ping: set PingTimeOut > 0 and verify, that the first database access shows 'need ping: yes' (unless a database handle has been created upon server startup). The second access immediately afterwards shows 'need ping: no' and the third access after timeout seconds again shows 'need ping: yes'. Always watch the same server ! De-activate ping with setting timeout = -1 and check for 'need ping: no'. 1.5. After having initiated a persistent connection check the perl-status menu-item 'DBI connections' ( http://localhost/perl-status?DBI ). Be sure, to check a server, which has a database handle ! Datasource Username dbname=test_auth ------------------------------------------------------------------- 2. Apache::AuthDBI::authen -------------------------- 2.1. normal authentication, setCacheTime(60), no cleanup handler ========== 25362 Apache::AuthDBI::authen request type = >initial main< 25362 Apache::AuthDBI::authen get_basic_auth_pw: res = >401<, password sent = >< -------------- here the password requester of the browser pops up -------- ========== 25364 Apache::AuthDBI::authen request type = >initial main< 25364 Apache::AuthDBI::authen get_basic_auth_pw: res = >0<, password sent = >support< 25364 Apache::AuthDBI::authen user sent = >support< 25364 Apache::AuthDBI::authen Config{ pwdcasesensitive } = on 25364 Apache::AuthDBI::authen Config{ pwd_whereclause } = 25364 Apache::AuthDBI::authen Config{ placeholder } = off 25364 Apache::AuthDBI::authen Config{ log_field } = 25364 Apache::AuthDBI::authen Config{ uid_field } = userid 25364 Apache::AuthDBI::authen Config{ authoritative } = on 25364 Apache::AuthDBI::authen Config{ data_source } = dbi:Pg:dbname=test_auth 25364 Apache::AuthDBI::authen Config{ grp_field } = groupid 25364 Apache::AuthDBI::authen Config{ encrypted } = on 25364 Apache::AuthDBI::authen Config{ pwd_field } = passwd 25364 Apache::AuthDBI::authen Config{ nopasswd } = off 25364 Apache::AuthDBI::authen Config{ grp_table } = groups 25364 Apache::AuthDBI::authen Config{ pwd_table } = users 25364 Apache::AuthDBI::authen Config{ password } = 25364 Apache::AuthDBI::authen Config{ log_string } = 25364 Apache::AuthDBI::authen Config{ uidcasesensitive } = on 25364 Apache::AuthDBI::authen Config{ username } = 25364 Apache::AuthDBI::authen Config{ grp_whereclause } = 25364 Apache::AuthDBI::authen passwd not found in cache 25364 Apache::AuthDBI::authen statement: SELECT passwd FROM users WHERE userid = 'support' 25364 Apache::AuthDBI::authen passwd = >su7/poGcpDQWY< 25364 Apache::AuthDBI::authen user support: password match for >su7/poGcpDQWY< 25364 Apache::AuthDBI::authen return OK 2.2. normal authentication as above, check if cached password is used discard all traces up to the Config section 25519 Apache::AuthDBI::authen cache: found >support,dbi:Pg:dbname=test_auth,users,userid< >935176023< >su7/poGcpDQWY< 25519 Apache::AuthDBI::authen passwd found in cache 25519 Apache::AuthDBI::authen passwd = >su7/poGcpDQWY< 25519 Apache::AuthDBI::authen user support: password match for >su7/poGcpDQWY< 25519 Apache::AuthDBI::authen secs since last CleanupHandler: 164, CleanupTime: 60 25519 Apache::AuthDBI::authen return OK 2.3. after successful authentication change password in database. Restart browser and check if password is looked up in the database again. 2.4. check normal authentication with several users, who share the same userid, but who have different passwords. 2.5. check normal authentication with more than one data_source parameter (and corresponding usernames and passwords), where the first connect fails and the second succeeds. Expect to see a warning about the failure. ------------------------------------------------------------------- 3. Apache::AuthDBI::authz ------------------------- 3.1. normal group authorization, setCacheTime(60) discard authentication traces ========== 25560 Apache::AuthDBI::authz request type = >initial main< 25560 Apache::AuthDBI::authz user sent = >support< 25560 Apache::AuthDBI::authz requirements: valid-user=>< user=>w3master< group=>group-a group-b group-support group-customer< 25560 Apache::AuthDBI::authz groups not found in cache 25560 Apache::AuthDBI::authz statement: SELECT groupid FROM groups WHERE userid = 'support' 25560 Apache::AuthDBI::authz groups = >group-support< 25560 Apache::AuthDBI::authz user support: group_result = OK for >group-support< 25560 Apache::AuthDBI::authz return OK ========== 25560 Apache::AuthDBI::authz request type = >< ========== 25560 Apache::AuthDBI::authz request type = >main< 3.2. normal authorization as above, check if cached password is used ========== 25560 Apache::AuthDBI::authz request type = >initial main< 25560 Apache::AuthDBI::authz user sent = >support< 25560 Apache::AuthDBI::authz requirements: valid-user=>< user=>w3master< group=>group-a group-b group-support group-customer< 25560 Apache::AuthDBI::authz cache: found >support,dbi:Pg:dbname=test_auth,users,userid< >935176510< >group-support< 25560 Apache::AuthDBI::authz groups found in cache 25560 Apache::AuthDBI::authz groups = >group-support< 25560 Apache::AuthDBI::authz user support: group_result = OK for >group-support< 25560 Apache::AuthDBI::authz return OK ========== 25560 Apache::AuthDBI::authz request type = >< ========== 25560 Apache::AuthDBI::authz request type = >main< 3.3. after successful authorization change group in database and .htaccess. Check if group is looked up in the database again. 3.4. check normal authorization with a specific required user. Expect to see no database access. 3.5. check normal group authorization with more than one data_source parameter, where the first connect fails and the second succeeds. Expect to see a warning about the failure. ------------------------------------------------------------------- 4. Apache::AuthDBI using the cleanup handler -------------------------------------------- 4.1. PerlCleanupHandler: configure setCleanupTime(60) and check that the first request does not create a PerlCleanupHandler: ... 1682 Apache::AuthDBI::authen secs since last CleanupHandler: 9, CleanupTime: 60 1682 Apache::AuthDBI::authen return OK ========== 1682 Apache::AuthDBI::authen request type = >< ========== 1682 Apache::AuthDBI::authen request type = >main< 4.2. PerlCleanupHandler: configure setCleanupTime(60) and check that a request after the configured time shows the following entries: ... 1682 Apache::AuthDBI::authen secs since last CleanupHandler: 244, CleanupTime: 60 1682 Apache::AuthDBI::authen push PerlCleanupHandler 1682 Apache::AuthDBI::authen return OK ========== 1682 Apache::AuthDBI::authen request type = >< ========== 1682 Apache::AuthDBI::authen request type = >main< 1682 Apache::AuthDBI PerlCleanupHandler 1682 Apache::AuthDBI PerlCleanupHandler keep >support,dbi:Pg:dbname=test_auth,users,userid< 4.3. Authentication: check if a previously used userid/password is deleted from cache, after the CacheTime has expired. For this, re-start the browser, re-authenticate with another userid and wait, until CacheTime and CleanupTime have expired. 1760 Apache::AuthDBI PerlCleanupHandler delete >w3master,dbi:Pg:dbname=test_auth,users,userid<, last access 157 s before 4.4. Authorization: check if a previously used userid/group is deleted from cache, after the CacheTime has expired. For this, re-start the browser, re-authenticate with another userid and wait, until CacheTime and CleanupTime have expired. 1760 Apache::AuthDBI PerlCleanupHandler delete >support,dbi:Pg:dbname=test_auth,users,userid<, last access 157 s before 5. Apache::AuthDBI using shared memory -------------------------------------- 5.1. PerlChildInitHandler: initIPC(10000) the following entries are supposed to appear in the error_log during server startup once for every server with increasing child count: 1479 Apache::AuthDBI PerlChildInitHandler child count = 1 1478 Apache::AuthDBI PerlChildInitHandler child count = 2 ... 5.2. using normal authentication, check if shared memory is used: expect to see the following entry just before the Config section: 1669 Apache::AuthDBI::authen cache in shared memory, shmid 2821, shmsize 10000, semid 642 using a command like ipcs should also show the IPC resources: ------ Shared Memory Segments -------- key shmid owner perms bytes nattch status 0x0103c80c 2821 httpd 600 10000 0 ------ Semaphore Arrays -------- key semid owner perms nsems status 0x0103c80c 642 httpd 600 1 5.3. PerlChildExitHandler: check if IPC resources are removed upon server shutdown. the following entries are supposed to appear in the error_log during server shutdown once for every server with decreasing child count: ... 1595 Apache::AuthDBI PerlChildExitHandler child count = 2 1596 Apache::AuthDBI PerlChildExitHandler child count = 1, remove shared memory 2309 and semaphore 386 # EOF Apache-DBI-1.12/t/10mysql.t000644 000765 000765 00000003052 12156020711 015423 0ustar00phredphred000000 000000 use strict; use Test::More tests => 10; BEGIN { # trick DBI.pm into thinking we are running under mod_perl # set both %ENV keys for old and new DBI versions $ENV{MOD_PERL} = 'CGI-Perl'; # for $DBI::VERSION > 1.33 $ENV{GATEWAY_INTERFACE} = 'CGI-Perl'; # for older DBI.pm use_ok('Apache::DBI'); use_ok('DBI'); }; my $dbd_mysql = eval { require DBD::mysql }; #$Apache::DBI::DEBUG = 10; #DBI->trace(2"); SKIP: { skip "Could not load DBD::mysql", 8 unless $dbd_mysql; ok($dbd_mysql, "DBD::mysql loaded"); SKIP: { skip 'Can only check "connect_via" in DBI >= 1.38', 1 unless $DBI::VERSION >= 1.38; # checking private DBI data here is probably bad... is($DBI::connect_via, 'Apache::DBI::connect', 'DBI is using Apache::DBI'); } my $dbh_1 = DBI->connect('dbi:mysql:test', undef, undef, { RaiseError => 0, PrintError => 0 }); SKIP: { skip "Could not connect to test database: $DBI::errstr", 6 unless $dbh_1; isa_ok($dbh_1, 'Apache::DBI::db'); ok(my $thread_1 = $dbh_1->{'mysql_thread_id'}, "Connected 1"); my $dbh_2 = DBI->connect('dbi:mysql:test', undef, undef, { RaiseError => 0, PrintError => 0 }); ok(my $thread_2 = $dbh_2->{'mysql_thread_id'}, "Connected 2"); is($thread_1, $thread_2, "got the same connection both times"); my $dbh_3 = DBI->connect('dbi:mysql:test', undef, undef, { RaiseError => 0, PrintError => 1 }); ok(my $thread_3 = $dbh_3->{'mysql_thread_id'}, "Connected 3"); isnt($thread_1, $thread_3, "got different connection from different attributes"); } } 1; Apache-DBI-1.12/lib/Apache/000755 000765 000765 00000000000 12156021310 015410 5ustar00phredphred000000 000000 Apache-DBI-1.12/lib/Apache/AuthDBI.pm000644 000765 000765 00000162177 12156021276 017217 0ustar00phredphred000000 000000 # $Id: AuthDBI.pm 1492087 2013-06-12 07:26:54Z phred $ package Apache::AuthDBI; $Apache::AuthDBI::VERSION = '1.12'; # 1: report about cache miss # 2: full debug output $Apache::AuthDBI::DEBUG = 0; use constant MP2 => (exists $ENV{MOD_PERL_API_VERSION} && $ENV{MOD_PERL_API_VERSION} == 2) ? 1 : 0; BEGIN { my @constants = qw( OK AUTH_REQUIRED FORBIDDEN DECLINED SERVER_ERROR ); if (MP2) { require Apache2::Access; require Apache2::Const; require Apache2::RequestRec; require Apache2::RequestUtil; require Apache2::Log; import Apache2::Const @constants; } else { require Apache::Constants; import Apache::Constants @constants; } } use strict; use DBI (); use Digest::SHA1 (); use Digest::MD5 (); sub debug { print STDERR "$_[1]\n" if $_[0] <= $Apache::AuthDBI::DEBUG; } sub push_handlers { if (MP2) { require Apache2::ServerUtil; my $s = Apache2::ServerUtil->server; $s->push_handlers(@_); } else { Apache->push_handlers(@_); } } # configuration attributes, defaults will be overwritten with values # from .htaccess. my %Config = ( 'Auth_DBI_data_source' => '', 'Auth_DBI_username' => '', 'Auth_DBI_password' => '', 'Auth_DBI_pwd_table' => '', 'Auth_DBI_uid_field' => '', 'Auth_DBI_pwd_field' => '', 'Auth_DBI_pwd_whereclause' => '', 'Auth_DBI_grp_table' => '', 'Auth_DBI_grp_field' => '', 'Auth_DBI_grp_whereclause' => '', 'Auth_DBI_log_field' => '', 'Auth_DBI_log_string' => '', 'Auth_DBI_authoritative' => 'on', 'Auth_DBI_nopasswd' => 'off', 'Auth_DBI_encrypted' => 'on', 'Auth_DBI_encryption_salt' => 'password', #Using Two (or more) Methods Will Allow for Fallback to older Methods 'Auth_DBI_encryption_method'=> 'sha1hex/md5/crypt', 'Auth_DBI_uidcasesensitive' => 'on', 'Auth_DBI_pwdcasesensitive' => 'on', 'Auth_DBI_placeholder' => 'off', 'Auth_DBI_expeditive' => 'on', ); # stores the configuration of current URL. # initialized during authentication, eventually re-used for authorization. my $Attr = {}; # global cache: all records are put into one string. # record separator is a newline. Field separator is $;. # every record is a list of id, time of last access, password, groups #(authorization only). # the id is a comma separated list of user_id, data_source, pwd_table, # uid_field. # the first record is a timestamp, which indicates the last run of the # CleanupHandler followed by the child counter. my $Cache = time . "$;0\n"; # unique id which serves as key in $Cache. # the id is generated during authentication and re-used for authorization. my $ID; # minimum lifetimes of cache entries in seconds. # setting the CacheTime to 0 will not use the cache at all. my $CacheTime = 0; # supposed to be called in a startup script. # sets CacheTime to a user defined value. sub setCacheTime { my $class = shift; my $cache_time = shift; # sanity check $CacheTime = $cache_time if $cache_time =~ /\d+/; } # minimum time interval in seconds between two runs of the PerlCleanupHandler. # setting CleanupTime to 0 will run the PerlCleanupHandler after every request. # setting CleanupTime to a negative value will disable the PerlCleanupHandler. my $CleanupTime = -1; # supposed to be called in a startup script. # sets CleanupTime to a user defined value. sub setCleanupTime { my $class = shift; my $cleanup_time = shift; # sanity check $CleanupTime = $cleanup_time if $cleanup_time =~ /\-*\d+/; } # optionally the string with the global cache can be stored in a shared memory # segment. the segment will be created from the first child and it will be # destroyed if the last child exits. the reason for not handling everything # in the main server is simply, that there is no way to setup # an ExitHandler which runs in the main server and which would remove the # shared memory and the semaphore.hence we have to keep track about the # number of children, so that the last one can do all the cleanup. # creating the shared memory in the first child also has the advantage, # that we don't have to cope with changing the ownership. if a shm-function # fails, the global cache will automatically fall back to one string # per process. my $SHMKEY = 0; # unique key for shared memory segment and semaphore set my $SEMID = 0; # id of semaphore set my $SHMID = 0; # id of shared memory segment my $SHMSIZE = 50000; # default size of shared memory segment my $SHMPROJID = 1; # default project id for shared memory segment # Supposed to be called in a startup script. # Sets SHMPROJID to a user defined value sub setProjID { my $class = shift; my $shmprojid = shift; #Set ProjID prior to calling initIPC! return if $SHMKEY; # sanity check - Must be numeric and less than or equal to 255 $SHMPROJID = int($shmprojid) if $shmprojid =~ /\d{1,3}/ && $shmprojid <= 255 && $shmprojid > 0; } # shortcuts for semaphores my $obtain_lock = pack("sss", 0, 0, 0) . pack("sss", 0, 1, 0); my $release_lock = pack("sss", 0, -1, 0); # supposed to be called in a startup script. # sets SHMSIZE to a user defined value and initializes the unique key, # used for the shared memory segment and for the semaphore set. # creates a PerlChildInitHandler which creates the shared memory segment # and the semaphore set. creates a PerlChildExitHandler which removes # the shared memory segment and the semaphore set upon server shutdown. # keep in mind, that this routine runs only once, when the main server #starts up. sub initIPC { my $class = shift; my $shmsize = shift; require IPC::SysV; # make sure, this method is called only once return if $SHMKEY; # ensure minimum size of shared memory segment $SHMSIZE = $shmsize if $shmsize >= 500; # generate unique key based on path of AuthDBI.pm + SHMPROJID foreach my $file (keys %INC) { if ($file eq 'Apache/AuthDBI.pm') { $SHMKEY = IPC::SysV::ftok($INC{$file}, $SHMPROJID); last; } } # provide a handler which initializes the shared memory segment #(first child) or which increments the child counter. push_handlers(PerlChildInitHandler => \&childinit); # provide a handler which decrements the child count or which # destroys the shared memory # segment upon server shutdown, which is defined by the exit of the # last child. push_handlers(PerlChildExitHandler => \&childexit); } # authentication handler sub authen { my ($r) = @_; my ($key, $val, $dbh); my $prefix = "$$ Apache::AuthDBI::authen"; if ($Apache::AuthDBI::DEBUG > 1) { my $type = ''; if (MP2) { $type .= 'initial ' if $r->is_initial_req(); $type .= 'main' if $r->main(); } else { $type .= 'initial ' if $r->is_initial_req; $type .= 'main' if $r->is_main; } debug (1, "==========\n$prefix request type = >$type<"); } return MP2 ? Apache2::Const::OK() : Apache::Constants::OK() unless $r->is_initial_req; # only the first internal request debug (2, "REQUEST:" . $r->as_string); # here the dialog pops up and asks you for username and password my ($res, $passwd_sent) = $r->get_basic_auth_pw; { no warnings qw(uninitialized); debug (2, "$prefix get_basic_auth_pw: res = >$res<, password sent = >$passwd_sent<"); } return $res if $res; # e.g. HTTP_UNAUTHORIZED # get username my $user_sent = $r->user; debug(2, "$prefix user sent = >$user_sent<"); # do we use shared memory for the global cache ? debug (2, "$prefix cache in shared memory, shmid $SHMID, shmsize $SHMSIZE, semid $SEMID"); # get configuration while(($key, $val) = each %Config) { $val = $r->dir_config($key) || $val; $key =~ s/^Auth_DBI_//; $Attr->{$key} = $val; debug(2, sprintf("$prefix Config{ %-16s } = %s", $key, $val)); } # parse connect attributes, which may be tilde separated lists my @data_sources = split /~/, $Attr->{data_source}; my @usernames = split /~/, $Attr->{username}; my @passwords = split /~/, $Attr->{password}; # use ENV{DBI_DSN} if not defined $data_sources[0] = '' unless $data_sources[0]; # obtain the id for the cache # remove any embedded attributes, because of trouble with regexps my $data_src = $Attr->{data_source}; $data_src =~ s/\(.+\)//g; $ID = join ',', $user_sent, $data_src, $Attr->{pwd_table}, $Attr->{uid_field}; # if not configured decline unless ($Attr->{pwd_table} && $Attr->{uid_field} && $Attr->{pwd_field}) { debug (2, "$prefix not configured, return DECLINED"); return MP2 ? Apache2::Const::DECLINED() : Apache::Constants::DECLINED(); } # do we want Windows-like case-insensitivity? $user_sent = lc $user_sent if $Attr->{uidcasesensitive} eq "off"; $passwd_sent = lc $passwd_sent if $Attr->{pwdcasesensitive} eq "off"; # check whether the user is cached but consider that the password # possibly has changed my $passwd = ''; if ($CacheTime) { # do we use the cache ? if ($SHMID) { # do we keep the cache in shared memory ? semop($SEMID, $obtain_lock) or warn "$prefix semop failed \n"; shmread($SHMID, $Cache, 0, $SHMSIZE) or warn "$prefix shmread failed \n"; substr($Cache, index($Cache, "\0")) = ''; semop($SEMID, $release_lock) or warn "$prefix semop failed \n"; } # find id in cache my ($last_access, $passwd_cached, $groups_cached); if ($Cache =~ /$ID$;(\d+)$;(.+)$;(.*)\n/) { $last_access = $1; $passwd_cached = $2; $groups_cached = $3; debug(2, "$prefix cache: found >$ID< >$last_access< >$passwd_cached<"); my @passwds_to_check = &get_passwds_to_check( $Attr, user_sent => $user_sent, passwd_sent => $passwd_sent, password => $passwd_cached ); debug(2, "$prefix " . scalar(@passwds_to_check) . " passwords to check"); foreach my $passwd_to_check (@passwds_to_check) { # match cached password with password sent $passwd = $passwd_cached if $passwd_to_check eq $passwd_cached; last if $passwd; } } } # found in cache if ($passwd) { debug(2, "$prefix passwd found in cache"); } else { # password not cached or changed debug (2, "$prefix passwd not found in cache"); # connect to database, use all data_sources until the connect succeeds for (my $j = 0; $j <= $#data_sources; $j++) { last if ( $dbh = DBI->connect( $data_sources[$j], $usernames[$j], $passwords[$j] ) ); } unless ($dbh) { $r->log_reason( "$prefix db connect error with data_source " . ">$Attr->{data_source}<: $DBI::errstr", $r->uri ); return MP2 ? Apache2::Const::SERVER_ERROR() : Apache::Constants::SERVER_ERROR(); } # generate statement my $user_sent_quoted = $dbh->quote($user_sent); my $select = "SELECT $Attr->{pwd_field}"; my $from = "FROM $Attr->{pwd_table}"; my $where = ($Attr->{uidcasesensitive} eq "off") ? "WHERE lower($Attr->{uid_field}) =" : "WHERE $Attr->{uid_field} ="; my $compare = ($Attr->{placeholder} eq "on") ? "?" : "$user_sent_quoted"; my $statement = "$select $from $where $compare"; $statement .= " AND $Attr->{pwd_whereclause}" if $Attr->{pwd_whereclause}; debug(2, "$prefix statement: $statement"); # prepare statement my $sth; unless ($sth = $dbh->prepare($statement)) { $r->log_reason("$prefix can not prepare statement: $DBI::errstr", $r->uri); $dbh->disconnect; return MP2 ? Apache2::Const::SERVER_ERROR() : Apache::Constants::SERVER_ERROR(); } # execute statement my $rv; unless ($rv = ($Attr->{placeholder} eq "on") ? $sth->execute($user_sent) : $sth->execute) { $r->log_reason("$prefix can not execute statement: $DBI::errstr", $r->uri); $dbh->disconnect; return MP2 ? Apache2::Const::SERVER_ERROR() : Apache::Constants::SERVER_ERROR(); } my $password; $sth->execute(); $sth->bind_columns(\$password); my $cnt = 0; while ($sth->fetch()) { $password =~ s/ +$// if $password; $passwd .= "$password$;"; $cnt++; } chop $passwd if $passwd; # so we can distinguish later on between no password and empty password undef $passwd if 0 == $cnt; if ($sth->err) { $dbh->disconnect; return MP2 ? Apache2::Const::SERVER_ERROR() : Apache::Constants::SERVER_ERROR(); } $sth->finish; # re-use dbh for logging option below $dbh->disconnect unless $Attr->{log_field} && $Attr->{log_string}; } $r->subprocess_env(REMOTE_PASSWORDS => $passwd); debug(2, "$prefix passwd = >$passwd<"); # check if password is needed unless ($passwd) { # not found in database # if authoritative insist that user is in database if ($Attr->{authoritative} eq 'on') { $r->log_reason("$prefix password for user $user_sent not found", $r->uri); $r->note_basic_auth_failure; return MP2 ? Apache2::Const::AUTH_REQUIRED() : Apache::Constants::AUTH_REQUIRED(); } else { # else pass control to the next authentication module return MP2 ? Apache2::Const::DECLINED() : Apache::Constants::DECLINED(); } } # allow any password if nopasswd = on and the retrieved password is empty if ($Attr->{nopasswd} eq 'on' && !$passwd) { return MP2 ? Apache2::Const::OK() : Apache::Constants::OK(); } # if nopasswd is off, reject user unless ($passwd_sent && $passwd) { $r->log_reason("$prefix user $user_sent: empty password(s) rejected", $r->uri); $r->note_basic_auth_failure; return MP2 ? Apache2::Const::AUTH_REQUIRED() : Apache::Constants::AUTH_REQUIRED(); } # compare passwords my $found = 0; foreach my $password (split /$;/, $passwd) { # compare all the passwords using as many encryption methods # in fallback as needed my @passwds_to_check = &get_passwds_to_check( $Attr, user_sent => $user_sent, passwd_sent => $passwd_sent, password => $password ); debug (2, "$prefix " . scalar(@passwds_to_check) . " passwords to check"); foreach my $passwd_to_check (@passwds_to_check) { debug( 2, "$prefix user $user_sent: Password after Preparation " . ">$passwd_to_check< - trying for a match with >$password<" ); if ($passwd_to_check eq $password) { $found = 1; $r->subprocess_env(REMOTE_PASSWORD => $password); debug ( 2, "$prefix user $user_sent: Password from Web Server " . ">$passwd_sent< - Password after Preparation >$passwd_to_check< - " . "password match for >$password<" ); # update timestamp and cache userid/password if CacheTime # is configured if ($CacheTime) { # do we use the cache ? if ($SHMID) { # do we keep the cache in shared memory ? semop($SEMID, $obtain_lock) or warn "$prefix semop failed \n"; shmread($SHMID, $Cache, 0, $SHMSIZE) or warn "$prefix shmread failed \n"; substr($Cache, index($Cache, "\0")) = ''; } # update timestamp and password or append new record my $now = time; if (!($Cache =~ s/$ID$;\d+$;.*$;(.*)\n/$ID$;$now$;$password$;$1\n/)) { $Cache .= "$ID$;$now$;$password$;\n"; } if ($SHMID) { # write cache to shared memory shmwrite($SHMID, $Cache, 0, $SHMSIZE) or warn "$prefix shmwrite failed \n"; semop($SEMID, $release_lock) or warn "$prefix semop failed \n"; } } last; } } #if the passwd matched (encrypted or otherwise), don't check the # myriad other passwords that may or may not exist last if $found > 0 ; } unless ($found) { $r->log_reason("$prefix user $user_sent: password mismatch", $r->uri); $r->note_basic_auth_failure; return MP2 ? Apache2::Const::AUTH_REQUIRED() : Apache::Constants::AUTH_REQUIRED(); } # logging option if ($Attr->{log_field} && $Attr->{log_string}) { if (!$dbh) { # connect to database if not already done my $connect; for (my $j = 0; $j <= $#data_sources; $j++) { if ($dbh = DBI->connect( $data_sources[$j], $usernames[$j], $passwords[$j] )) { $connect = 1; last; } } unless ($connect) { $r->log_reason("$prefix db connect error with $Attr->{data_source}", $r->uri); return MP2 ? Apache2::Const::SERVER_ERROR() : Apache::Constants::SERVER_ERROR(); } } my $user_sent_quoted = $dbh->quote($user_sent); my $statement = "UPDATE $Attr->{pwd_table} SET $Attr->{log_field} = " . "$Attr->{log_string} WHERE $Attr->{uid_field}=$user_sent_quoted"; debug(2, "$prefix statement: $statement"); unless ($dbh->do($statement)) { $r->log_reason("$prefix can not do statement: $DBI::errstr", $r->uri); $dbh->disconnect; return MP2 ? Apache2::Const::SERVER_ERROR() : Apache::Constants::SERVER_ERROR(); } $dbh->disconnect; } # Unless the cache or the CleanupHandler is disabled, the # CleanupHandler is initiated if the last run was more than # $CleanupTime seconds before. # Note, that it runs after the request, hence it cleans also the # authorization entries if ($CacheTime and $CleanupTime >= 0) { my $diff = time - substr $Cache, 0, index($Cache, "$;"); debug( 2, "$prefix secs since last CleanupHandler: $diff, CleanupTime: " . "$CleanupTime" ); if ($diff > $CleanupTime) { debug (2, "$prefix push PerlCleanupHandler"); push_handlers(PerlCleanupHandler => \&cleanup); } } debug (2, "$prefix return OK\n"); return MP2 ? Apache2::Const::OK() : Apache::Constants::OK(); } #Encrypts a password in all supported/requested methods and passes back #array for comparison sub get_passwds_to_check { my $Attr = shift; my %params = @_; my ($prefix) = "$$ Apache::AuthDBI::get_passwds_to_check "; my ($salt, @passwds_to_check); if ($Attr->{encrypted} eq 'on') { #SHA1 if ($Attr->{encryption_method} =~ /(^|\/)sha1hex($|\/)/i) { push @passwds_to_check, SHA1_digest( text => $params{'passwd_sent'}, format => 'hex' ); } #MD5 if ($Attr->{encryption_method} =~ /(^|\/)md5hex($|\/)/i) { push @passwds_to_check, MD5_digest( text => $params{'passwd_sent'}, format => 'hex' ); } #CRYPT if ($Attr->{encryption_method} =~ /(^|\/)crypt($|\/)/i) { $salt = $Attr->{encryption_salt} eq 'userid' ? $params{'user_sent'} : $params{'password'}; #Bug Fix in v0.94 (marked as 0.93 in file. salt was NOT being sent # to crypt) - KAM - 06-16-2005 push @passwds_to_check, crypt($params{'passwd_sent'}, $salt); } #WE DIDN'T GET ANY PASSWORDS TO CHECK. MUST BE A PROBLEM if (scalar(@passwds_to_check) < 1) { debug (2, "$prefix Error: No Valid Encryption Method Specified"); } } else { #IF NO ENCRYPTION, JUST PUSH THE CLEARTEXT PASS push @passwds_to_check, $params{'passwd_sent'}; } return (@passwds_to_check); } # authorization handler, it is called immediately after the authentication sub authz { my $r = shift; my ($key, $val, $dbh); my $prefix = "$$ Apache::AuthDBI::authz "; if ($Apache::AuthDBI::DEBUG > 1) { my $type = ''; if (MP2) { $type .= 'initial ' if $r->is_initial_req(); $type .= 'main' if $r->main(); } else { $type .= 'initial ' if $r->is_initial_req; $type .= 'main' if $r->is_main; } debug(1, "==========\n$prefix request type = >$type<"); } # only the first internal request unless ($r->is_initial_req) { return MP2 ? Apache2::Const::OK() : Apache::Constants::OK(); } my $user_result = MP2 ? Apache2::Const::DECLINED() : Apache::Constants::DECLINED(); my $group_result = MP2 ? Apache2::Const::DECLINED() : Apache::Constants::DECLINED(); # get username my $user_sent = $r->user; debug(2, "$prefix user sent = >$user_sent<"); # here we could read the configuration, but we re-use the configuration # from the authentication # parse connect attributes, which may be tilde separated lists my @data_sources = split /~/, $Attr->{data_source}; my @usernames = split /~/, $Attr->{username}; my @passwords = split /~/, $Attr->{password}; # use ENV{DBI_DSN} if not defined $data_sources[0] = '' unless $data_sources[0]; # if not configured decline unless ($Attr->{pwd_table} && $Attr->{uid_field} && $Attr->{grp_field}) { debug(2, "$prefix not configured, return DECLINED"); return MP2 ? Apache2::Const::DECLINED() : Apache::Constants::DECLINED(); } # do we want Windows-like case-insensitivity? $user_sent = lc $user_sent if $Attr->{uidcasesensitive} eq "off"; # select code to return if authorization is denied: my $authz_denied; if (MP2) { $authz_denied = $Attr->{expeditive} eq 'on' ? Apache2::Const::FORBIDDEN() : Apache2::Const::AUTH_REQUIRED(); } else { $authz_denied = $Attr->{expeditive} eq 'on' ? Apache::Constants::FORBIDDEN() : Apache::Constants::AUTH_REQUIRED(); } # check if requirements exists my $ary_ref = $r->requires; unless ($ary_ref) { if ($Attr->{authoritative} eq 'on') { $r->log_reason("user $user_sent denied, no access rules specified (DBI-Authoritative)", $r->uri); if ($authz_denied == (MP2 ? Apache2::Const::AUTH_REQUIRED() : Apache::Constants::AUTH_REQUIRED())) { $r->note_basic_auth_failure; } return $authz_denied; } debug (2, "$prefix no requirements and not authoritative, return DECLINED"); return MP2 ? Apache2::Const::DECLINED() : Apache::Constants::DECLINED(); } # iterate over all requirement directives and store them according to # their type (valid-user, user, group) my($valid_user, $user_requirements, $group_requirements); foreach my $hash_ref (@$ary_ref) { while (($key,$val) = each %$hash_ref) { last if $key eq 'requirement'; } $val =~ s/^\s*require\s+//; # handle different requirement-types if ($val =~ /valid-user/) { $valid_user = 1; } elsif ($val =~ s/^user\s+//g) { $user_requirements .= " $val"; } elsif ($val =~ s/^group\s+//g) { $group_requirements .= " $val"; } } $user_requirements =~ s/^ //g if $user_requirements; $group_requirements =~ s/^ //g if $group_requirements; { no warnings qw(uninitialized); debug( 2, "$prefix requirements: [valid-user=>$valid_user<] [user=>" . "$user_requirements<] [group=>$group_requirements<]" ); } # check for valid-user if ($valid_user) { $user_result = MP2 ? Apache2::Const::OK() : Apache::Constants::OK(); debug(2, "$prefix user_result = OK: valid-user"); } # check for users if (($user_result != (MP2 ? Apache2::Const::OK() : Apache::Constants::OK())) && $user_requirements) { $user_result = MP2 ? Apache2::Const::AUTH_REQUIRED() : Apache::Constants::AUTH_REQUIRED(); foreach my $user_required (split /\s+/, $user_requirements) { if ($user_required eq $user_sent) { debug (2, "$prefix user_result = OK for $user_required"); $user_result = MP2 ? Apache2::Const::OK() : Apache::Constants::OK(); last; } } } my $user_result_valid = MP2 ? Apache2::Const::OK() : Apache::Constants::OK(); # check for groups if ($user_result != $user_result_valid && $group_requirements) { debug(2, "$prefix: checking for groups >$group_requirements<"); $group_result = MP2 ? Apache2::Const::AUTH_REQUIRED() : Apache::Constants::AUTH_REQUIRED(); my $group; # check whether the user is cached but consider that the group # possibly has changed my $groups = ''; if ($CacheTime) { # do we use the cache ? # we need to get the cached groups for the current id, # which has been read already # during authentication, so we do not read the Cache from # shared memory again my ($last_access, $passwd_cached, $groups_cached); if ($Cache =~ /$ID$;(\d+)$;(.*)$;(.+)\n/) { $last_access = $1; $passwd_cached = $2; $groups_cached = $3; debug(2, "$prefix cache: found >$ID< >$last_access< >$groups_cached"); REQUIRE_1: foreach my $group_required (split /\s+/, $group_requirements) { foreach $group (split(/,/, $groups_cached)) { if ($group_required eq $group) { $groups = $groups_cached; last REQUIRE_1; } } } } } # found in cache if ($groups) { debug(2, "$prefix groups found in cache"); } else { # groups not cached or changed debug(2, "$prefix groups not found in cache"); # connect to database, use all data_sources until the connect # succeeds my $connect; for (my $j = 0; $j <= $#data_sources; $j++) { if ($dbh = DBI->connect( $data_sources[$j], $usernames[$j], $passwords[$j] )) { $connect = 1; last; } } unless ($connect) { $r->log_reason( "$prefix db connect error with " . "$Attr->{data_source}", $r->uri ); return MP2 ? Apache2::Const::SERVER_ERROR() : Apache::Constants::SERVER_ERROR(); } # generate statement my $user_sent_quoted = $dbh->quote($user_sent); my $select = "SELECT $Attr->{grp_field}"; my $from = ($Attr->{grp_table}) ? "FROM $Attr->{grp_table}" : "FROM $Attr->{pwd_table}"; my $where = ($Attr->{uidcasesensitive} eq "off") ? "WHERE lower($Attr->{uid_field}) =" : "WHERE $Attr->{uid_field} ="; my $compare = ($Attr->{placeholder} eq "on") ? "?" : "$user_sent_quoted"; my $statement = "$select $from $where $compare"; $statement .= " AND $Attr->{grp_whereclause}" if ($Attr->{grp_whereclause}); debug(2, "$prefix statement: $statement"); # prepare statement my $sth; unless ($sth = $dbh->prepare($statement)) { $r->log_reason( "can not prepare statement: $DBI::errstr", $r->uri ); $dbh->disconnect; return MP2 ? Apache2::Const::SERVER_ERROR() : Apache::Constants::SERVER_ERROR(); } # execute statement my $rv; unless ($rv = ($Attr->{placeholder} eq "on") ? $sth->execute($user_sent) : $sth->execute) { $r->log_reason( "can not execute statement: $DBI::errstr", $r->uri ); $dbh->disconnect; return MP2 ? Apache2::Const::SERVER_ERROR() : Apache::Constants::SERVER_ERROR(); } # fetch result and build a group-list # strip trailing blanks for fixed-length data-type while (my $group = $sth->fetchrow_array) { $group =~ s/ +$//; $groups .= "$group,"; } chop $groups if $groups; $sth->finish; $dbh->disconnect; } $r->subprocess_env(REMOTE_GROUPS => $groups); debug(2, "$prefix groups = >$groups<\n"); # skip through the required groups until the first matches REQUIRE_2: foreach my $group_required (split /\s+/, $group_requirements) { foreach my $group (split(/,/, $groups)) { # check group if ($group_required eq $group) { $group_result = MP2 ? Apache2::Const::OK() : Apache::Constants::OK(); $r->subprocess_env(REMOTE_GROUP => $group); debug( 2, "$prefix user $user_sent: group_result = OK " . "for >$group<" ); # update timestamp and cache userid/groups if # CacheTime is configured if ($CacheTime) { # do we use the cache ? if ($SHMID) { # do we keep the cache in shared memory ? semop($SEMID, $obtain_lock) or warn "$prefix semop failed \n"; shmread($SHMID, $Cache, 0, $SHMSIZE) or warn "$prefix shmread failed \n"; substr($Cache, index($Cache, "\0")) = ''; } # update timestamp and groups my $now = time; # entry must exists from authentication $Cache =~ s/$ID$;\d+$;(.*)$;.*\n/$ID$;$now$;$1$;$groups\n/; if ($SHMID) { # write cache to shared memory shmwrite($SHMID, $Cache, 0, $SHMSIZE) or warn "$prefix shmwrite failed \n"; semop($SEMID, $release_lock) or warn "$prefix semop failed \n"; } } last REQUIRE_2; } } } } # check the results of the requirement checks if ($Attr->{authoritative} eq 'on' && ( $user_result != (MP2 ? Apache2::Const::OK() : Apache::Constants::OK()) ) && ( $group_result != (MP2 ? Apache2::Const::OK() : Apache::Constants::OK()) ) ) { my $reason; if ($user_result == (MP2 ? Apache2::Const::AUTH_REQUIRED() : Apache::Constants::AUTH_REQUIRED())) { $reason .= " USER"; } if ($group_result == (MP2 ? Apache2::Const::AUTH_REQUIRED() : Apache::Constants::AUTH_REQUIRED())) { $reason .= " GROUP"; } $r->log_reason( "DBI-Authoritative: Access denied on $reason rule(s)", $r->uri ); if ($authz_denied == (MP2 ? Apache2::Const::AUTH_REQUIRED() : Apache::Constants::AUTH_REQUIRED())) { $r->note_basic_auth_failure; } return $authz_denied; } # return OK if authorization was successful my $success = MP2 ? Apache2::Const::OK() : Apache::Constants::OK(); my $declined = MP2 ? Apache2::Const::DECLINED() : Apache::Constants::DECLINED(); if ( ($user_result != $declined && $user_result == $success) || ($group_result != $declined && $group_result == $success) ) { debug(2, "$prefix return OK"); return MP2 ? Apache2::Const::OK() : Apache::Constants::OK(); } # otherwise fall through debug(2, "$prefix fall through, return DECLINED"); return MP2 ? Apache2::Const::DECLINED() : Apache::Constants::DECLINED(); } sub dec2hex { my $dec = shift; return sprintf("%lx", $dec); } # The PerlChildInitHandler initializes the shared memory segment (first child) # or increments the child counter. # Note: this handler runs in every child server, but not in the main server. # create (or re-use existing) semaphore set sub childinit { my $prefix = "$$ Apache::AuthDBI PerlChildInitHandler"; my $SHMKEY_hex = dec2hex($SHMKEY); debug( 2, "$prefix SHMProjID = >$SHMPROJID< Shared Memory Key >$SHMKEY " . "Decimal - $SHMKEY_hex Hex<" ); $SEMID = semget( $SHMKEY, 1, IPC::SysV::IPC_CREAT() | IPC::SysV::S_IRUSR() | IPC::SysV::S_IWUSR() ); unless (defined $SEMID) { warn "$prefix semget failed - SHMKEY $SHMKEY - Error $!\n"; if (uc chomp $! eq 'PERMISSION DENIED') { warn " $prefix Read/Write Permission Denied to Shared Memory Array.\n"; warn " $prefix Use ipcs -s to list semaphores and look for " . "$SHMKEY_hex. If found, shutdown Apache and use ipcrm sem " . "$SHMKEY_hex to remove the colliding (and hopefully " . "unused) semaphore. See documentation for setProjID " . "for more information. \n"; } return; } # create (or re-use existing) shared memory segment $SHMID = shmget( $SHMKEY, $SHMSIZE, IPC::SysV::IPC_CREAT() | IPC::SysV::S_IRUSR() | IPC::SysV::S_IWUSR() ); unless (defined $SHMID) { warn "$prefix shmget failed - Error $!\n"; return; } # make ids accessible to other handlers $ENV{AUTH_SEMID} = $SEMID; $ENV{AUTH_SHMID} = $SHMID; # read shared memory, increment child count and write shared memory # segment semop($SEMID, $obtain_lock) or warn "$prefix semop failed \n"; shmread($SHMID, $Cache, 0, $SHMSIZE) or warn "$prefix shmread failed \n"; substr($Cache, index($Cache, "\0")) = ''; # segment already exists (eg start of additional server) my $child_count_new = 1; if ($Cache =~ /^(\d+)$;(\d+)\n/) { my $time_stamp = $1; my $child_count = $2; $child_count_new = $child_count + 1; $Cache =~ s/^$time_stamp$;$child_count\n/$time_stamp$;$child_count_new\n/; } else { # first child => initialize segment $Cache = time . "$;$child_count_new\n"; } debug(2, "$prefix child count = $child_count_new"); shmwrite($SHMID, $Cache, 0, $SHMSIZE) or warn "$prefix shmwrite failed \n"; semop($SEMID, $release_lock) or warn "$prefix semop failed \n"; 1; } # The PerlChildExitHandler decrements the child count or destroys the shared # memory segment upon server shutdown, which is defined by the exit of the # last child. # Note: this handler runs in every child server, but not in the main server. sub childexit { my $prefix = "$$ Apache::AuthDBI PerlChildExitHandler"; # read Cache from shared memory, decrement child count and exit or write #Cache to shared memory semop($SEMID, $obtain_lock) or warn "$prefix semop failed \n"; shmread($SHMID, $Cache, 0, $SHMSIZE) or warn "$prefix shmread failed \n"; substr($Cache, index($Cache, "\0")) = ''; $Cache =~ /^(\d+)$;(\d+)\n/; my $time_stamp = $1; my $child_count = $2; my $child_count_new = $child_count - 1; if ($child_count_new) { debug(2, "$prefix child count = $child_count"); # write Cache into shared memory $Cache =~ s/^$time_stamp$;$child_count\n/$time_stamp$;$child_count_new\n/; shmwrite($SHMID, $Cache, 0, $SHMSIZE) or warn "$prefix shmwrite failed \n"; semop($SEMID, $release_lock) or warn "$prefix semop failed \n"; } else { # last child # remove shared memory segment and semaphore set debug( 2, "$prefix child count = $child_count, remove shared memory " . "$SHMID and semaphore $SEMID" ); shmctl($SHMID, IPC::SysV::IPC_RMID(), 0) or warn "$prefix shmctl failed \n"; semctl($SEMID, 0, IPC::SysV::IPC_RMID(), 0) or warn "$prefix semctl failed \n"; } 1; } # The PerlCleanupHandler skips through the cache and deletes any outdated # entry. # Note: this handler runs after the response has been sent to the client. sub cleanup { my $prefix = "$$ Apache::AuthDBI PerlCleanupHandler"; debug(2, "$prefix"); # do we keep the cache in shared memory ? my $now = time; if ($SHMID) { semop($SEMID, $obtain_lock) or warn "$prefix semop failed \n"; shmread($SHMID, $Cache, 0, $SHMSIZE) or warn "$prefix shmread failed \n"; substr($Cache, index($Cache, "\0")) = ''; } # initialize timestamp for CleanupHandler my $newCache = "$now$;"; my ($time_stamp, $child_count); foreach my $record (split(/\n/, $Cache)) { # first record: timestamp of CleanupHandler and child count if (!$time_stamp) { ($time_stamp, $child_count) = split /$;/, $record; $newCache .= "$child_count\n"; next; } my ($id, $last_access, $passwd, $groups) = split /$;/, $record; my $diff = $now - $last_access; if ($diff >= $CacheTime) { debug(2, "$prefix delete >$id<, last access $diff s before"); } else { debug(2, "$prefix keep >$id<, last access $diff s before"); $newCache .= "$id$;$now$;$passwd$;$groups\n"; } } # write Cache to shared memory $Cache = $newCache; if ($SHMID) { shmwrite($SHMID, $Cache, 0, $SHMSIZE) or warn "$prefix shmwrite failed \n"; semop($SEMID, $release_lock) or warn "$prefix semop failed \n"; } 1; } # Added 06-14-2005 - KAM - Returns SHA1 digest - Modified from PerlCMS' more # generic routine to remove IO::File requirement sub SHA1_digest { my %params = @_; my $prefix = "$$ Apache::AuthDBI SHA1_digest"; debug(2, $prefix); $params{'format'} ||= "base64"; my $sha1 = Digest::SHA1->new(); if ($params{'text'} ne '') { $sha1->add($params{'text'}); } else { return -1; } if ($params{'format'} =~ /base64/i) { return $sha1->b64digest; } elsif ($params{'format'} =~ /hex/i) { return $sha1->hexdigest; } elsif ($params{'format'} =~ /binary/i) { return $sha1->binary; } -1; } # Added 06-20-2005 - KAM - Returns MD5 digest - Modified from PerlCMS' more # generic routine to remove IO::File requirement sub MD5_digest { my %params = @_; my $prefix = "$$ Apache::AuthDBI MD5_digest"; debug(2, $prefix); $params{'format'} ||= "hex"; my $md5 = Digest::MD5->new(); if ($params{'text'} ne '') { $md5->add($params{'text'}); } else { return -1; } if ($params{'format'} =~ /base64/i) { return $md5->b64digest; } elsif ($params{'format'} =~ /hex/i) { return $md5->hexdigest; } elsif ($params{'format'} =~ /binary/i) { return $md5->digest; } -1; } 1; __END__ =head1 NAME Apache::AuthDBI - Authentication and Authorization via Perl's DBI =head1 SYNOPSIS # Configuration in httpd.conf or startup.pl: PerlModule Apache::AuthDBI # Authentication and Authorization in .htaccess: AuthName DBI AuthType Basic PerlAuthenHandler Apache::AuthDBI::authen PerlAuthzHandler Apache::AuthDBI::authz PerlSetVar Auth_DBI_data_source dbi:driver:dsn PerlSetVar Auth_DBI_username db_username PerlSetVar Auth_DBI_password db_password #DBI->connect($data_source, $username, $password) PerlSetVar Auth_DBI_pwd_table users PerlSetVar Auth_DBI_uid_field username PerlSetVar Auth_DBI_pwd_field password # authentication: SELECT pwd_field FROM pwd_table WHERE uid_field=$user PerlSetVar Auth_DBI_grp_field groupname # authorization: SELECT grp_field FROM pwd_table WHERE uid_field=$user require valid-user require user user_1 user_2 ... require group group_1 group_2 ... The AuthType is limited to Basic. You may use one or more valid require lines. For a single require line with the requirement 'valid-user' or with the requirements 'user user_1 user_2 ...' it is sufficient to use only the authentication handler. =head1 DESCRIPTION This module allows authentication and authorization against a database using Perl's DBI. For supported DBI drivers see: http://dbi.perl.org/ Authentication: For the given username the password is looked up in the cache. If the cache is not configured or if the user is not found in the cache, or if the given password does not match the cached password, it is requested from the database. If the username does not exist and the authoritative directive is set to 'on', the request is rejected. If the authoritative directive is set to 'off', the control is passed on to next module in line. If the password from the database for the given username is empty and the nopasswd directive is set to 'off', the request is rejected. If the nopasswd directive is set to 'on', any password is accepted. Finally the passwords (multiple passwords per userid are allowed) are retrieved from the database. The result is put into the environment variable REMOTE_PASSWORDS. Then it is compared to the password given. If the encrypted directive is set to 'on', the given password is encrypted using perl's crypt() function before comparison. If the encrypted directive is set to 'off' the plain-text passwords are compared. If this comparison fails the request is rejected, otherwise the request is accepted and the password is put into the environment variable REMOTE_PASSWORD. The SQL-select used for retrieving the passwords is as follows: SELECT pwd_field FROM pwd_table WHERE uid_field = user If a pwd_whereclause exists, it is appended to the SQL-select. This module supports in addition a simple kind of logging mechanism. Whenever the handler is called and a log_string is configured, the log_field will be updated with the log_string. As log_string - depending upon the database - macros like TODAY can be used. The SQL-select used for the logging mechanism is as follows: UPDATE pwd_table SET log_field = log_string WHERE uid_field = user Authorization: When the authorization handler is called, the authentication has already been done. This means, that the given username/password has been validated. The handler analyzes and processes the requirements line by line. The request is accepted if the first requirement is fulfilled. In case of 'valid-user' the request is accepted. In case of one or more user-names, they are compared with the given user-name until the first match. In case of one or more group-names, all groups of the given username are looked up in the cache. If the cache is not configured or if the user is not found in the cache, or if the requested group does not match the cached group, the groups are requested from the database. A comma separated list of all these groups is put into the environment variable REMOTE_GROUPS. Then these groups are compared with the required groups until the first match. If there is no match and the authoritative directive is set to 'on' the request is rejected. In case the authorization succeeds, the environment variable REMOTE_GROUP is set to the group name, which can be used by user scripts without accessing the database again. The SQL-select used for retrieving the groups is as follows (depending upon the existence of a grp_table): SELECT grp_field FROM pwd_table WHERE uid_field = user SELECT grp_field FROM grp_table WHERE uid_field = user This way the group-information can either be held in the main users table, or in an extra table, if there is an m:n relationship between users and groups. From all selected groups a comma-separated list is build, which is compared with the required groups. If you don't like normalized group records you can put such a comma-separated list of groups (no spaces) into the grp_field instead of single groups. If a grp_whereclause exists, it is appended to the SQL-select. Cache: The module maintains an optional cash for all passwords/groups. See the method setCacheTime(n) on how to enable the cache. Every server has it's own cache. Optionally the cache can be put into a shared memory segment, so that it can be shared among all servers. See the CONFIGURATION section on how to enable the usage of shared memory. In order to prevent the cache from growing indefinitely a CleanupHandler can be initialized, which skips through the cache and deletes all outdated entries. This can be done once per request after sending the response, hence without slowing down response time to the client. The minimum time between two successive runs of the CleanupHandler is configurable (see the CONFIGURATION section). The default is 0, which runs the CleanupHandler after every request. =head1 LIST OF TOKENS =over =item * Auth_DBI_data_source (Authentication and Authorization) The data_source value has the syntax 'dbi:driver:dsn'. This parameter is passed to the database driver for processing during connect. The data_source parameter (as well as the username and the password parameters) may be a tilde ('~') separated list of several data_sources. All of these triples will be used until a successful connect is made. This way several backup-servers can be configured. if you want to use the environment variable DBI_DSN instead of a data_source, do not specify this parameter at all. =item * Auth_DBI_username (Authentication and Authorization) The username argument is passed to the database driver for processing during connect. This parameter may be a tilde ('~') separated list. See the data_source parameter above for the usage of a list. =item * Auth_DBI_password (Authentication and Authorization) The password argument is passed to the database driver for processing during connect. This parameter may be a tilde ('~') separated list. See the data_source parameter above for the usage of a list. =item * Auth_DBI_pwd_table (Authentication and Authorization) Contains at least the fields with the username and the (possibly encrypted) password. The username should be unique. =item * Auth_DBI_uid_field (Authentication and Authorization) Field name containing the username in the Auth_DBI_pwd_table. =item * Auth_DBI_pwd_field (Authentication only) Field name containing the password in the Auth_DBI_pwd_table. =item * Auth_DBI_pwd_whereclause (Authentication only) Use this option for specifying more constraints to the SQL-select. =item * Auth_DBI_grp_table (Authorization only) Contains at least the fields with the username and the groupname. =item * Auth_DBI_grp_field (Authorization only) Field-name containing the groupname in the Auth_DBI_grp_table. =item * Auth_DBI_grp_whereclause (Authorization only) Use this option for specifying more constraints to the SQL-select. =item * Auth_DBI_log_field (Authentication only) Field name containing the log string in the Auth_DBI_pwd_table. =item * Auth_DBI_log_string (Authentication only) String to update the Auth_DBI_log_field in the Auth_DBI_pwd_table. Depending upon the database this can be a macro like 'TODAY'. =item * Auth_DBI_authoritative < on / off> (Authentication and Authorization) Default is 'on'. When set 'on', there is no fall-through to other authentication methods if the authentication check fails. When this directive is set to 'off', control is passed on to any other authentication modules. Be sure you know what you are doing when you decide to switch it off. =item * Auth_DBI_nopasswd < on / off > (Authentication only) Default is 'off'. When set 'on' the password comparison is skipped if the password retrieved from the database is empty, i.e. allow any password. This is 'off' by default to ensure that an empty Auth_DBI_pwd_field does not allow people to log in with a random password. Be sure you know what you are doing when you decide to switch it on. =item * Auth_DBI_encrypted < on / off > (Authentication only) Default is 'on'. When set to 'on', the password retrieved from the database is assumed to be crypted. Hence the incoming password will be crypted before comparison. When this directive is set to 'off', the comparison is done directly with the plain-text entered password. =item * Auth_DBI_encryption_method < sha1hex/md5hex/crypt > (Authentication only) Default is blank. When set to one or more encryption method, the password retrieved from the database is assumed to be crypted. Hence the incoming password will be crypted before comparison. The method supports falling back so specifying 'sha1hex/md5hex' would allow for a site that is upgrading to sha1 to support both methods. sha1 is the recommended method. =item * Auth_DBI_encryption_salt < password / userid > (Authentication only) When crypting the given password AuthDBI uses per default the password selected from the database as salt. Setting this parameter to 'userid', the module uses the userid as salt. =item * Auth_DBI_uidcasesensitive < on / off > (Authentication and Authorization) Default is 'on'. When set 'off', the entered userid is converted to lower case. Also the userid in the password select-statement is converted to lower case. =item * Auth_DBI_pwdcasesensitive < on / off > (Authentication only) Default is 'on'. When set 'off', the entered password is converted to lower case. =item * Auth_DBI_placeholder < on / off > (Authentication and Authorization) Default is 'off'. When set 'on', the select statement is prepared using a placeholder for the username. This may result in improved performance for databases supporting this method. =back =head1 CONFIGURATION The module should be loaded upon startup of the Apache daemon. Add the following line to your httpd.conf: PerlModule Apache::AuthDBI A common usage is to load the module in a startup file via the PerlRequire directive. See eg/startup.pl for an example. There are three configurations which are server-specific and which can be done in a startup file: Apache::AuthDBI->setCacheTime(0); This configures the lifetime in seconds for the entries in the cache. Default is 0, which turns off the cache. When set to any value n > 0, the passwords/groups of all users will be cached for at least n seconds. After finishing the request, a special handler skips through the cache and deletes all outdated entries (entries, which are older than the CacheTime). Apache::AuthDBI->setCleanupTime(-1); This configures the minimum time in seconds between two successive runs of the CleanupHandler, which deletes all outdated entries from the cache. The default is -1, which disables the CleanupHandler. Setting the interval to 0 runs the CleanupHandler after every request. For a heavily loaded server this should be set to a value, which reflects a compromise between scanning a large cache possibly containing many outdated entries and between running many times the CleanupHandler on a cache containing only few entries. Apache::AuthDBI->setProjID(1); This configures the project ID used to create a semaphore ID for shared memory. It can be set to any integer 1 to 255 or it will default to a value of 1. NOTE: This must be set prior to calling initIPC. If you are running multiple instances of Apache on the same server\ (for example, Apache1 and Apache2), you may not want (or be able) to use shared memory between them. In this case, use a different project ID on each server. If you are reading this because you suspect you have a permission issue or a collision with a semaphore, use 'ipcs -s' to list semaphores and look for the Semaphore ID from the apache error log. If found, shutdown Apache (all of them) and use 'ipcrm sem ' to remove the colliding (and hopefully unused) semaphore. You may also want to remove any orphaned shared memory segments by using 'ipcs -m' and removing the orphans with ipcrm shm . Apache::AuthDBI->initIPC(50000); This enables the usage of shared memory for the cache. Instead of every server maintaining it's own cache, all servers have access to a common cache. This should minimize the database load considerably for sites running many servers. The number indicates the size of the shared memory segment in bytes. This size is fixed, there is no dynamic allocation of more segments. As a rule of thumb multiply the estimated maximum number of simultaneously cached users by 100 to get a rough estimate of the needed size. Values below 500 will be overwritten with the default 50000. To enable debugging the variable $Apache::AuthDBI::DEBUG must be set. This can either be done in startup.pl or in the user script. Setting the variable to 1, just reports about a cache miss. Setting the variable to 2 enables full debug output. =head1 PREREQUISITES =head2 MOD_PERL 2.0 Apache::DBI version 0.96 and should work under mod_perl 2.0 RC5 and later with httpd 2.0.49 and later. Apache::DBI versions less than 1.00 are NO longer supported. Additionally, mod_perl versions less then 2.0.0 are NO longer supported. =head2 MOD_PERL 1.0 Note that this module needs mod_perl-1.08 or higher, apache_1.3.0 or higher and that mod_perl needs to be configured with the appropriate call-back hooks: PERL_AUTHEN=1 PERL_AUTHZ=1 PERL_CLEANUP=1 PERL_STACKED_HANDLERS=1 Apache::DBI v0.94 was the last version before dual mod_perl 2.x support was begun. It still recommened that you use the latest version of Apache::DBI because Apache::DBI versions less than 1.00 are NO longer supported. =head1 SECURITY In some cases it is more secure not to put the username and the password in the .htaccess file. The following example shows a solution to this problem: httpd.conf: my($uid,$pwd) = My::dbi_pwd_fetch(); $Location{'/foo/bar'}->{PerlSetVar} = [ [ Auth_DBI_username => $uid ], [ Auth_DBI_password => $pwd ], ]; =head1 SEE ALSO L, L, L =head1 AUTHORS =over =item * Apache::AuthDBI by Edmund Mergl; now maintained and supported by the modperl mailinglist, subscribe by sending mail to modperl-subscribe@perl.apache.org. =item * mod_perl by Doug MacEachern. =item * DBI by Tim Bunce =back =head1 COPYRIGHT The Apache::AuthDBI module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Apache-DBI-1.12/lib/Apache/DBI.pm000644 000765 000765 00000051441 12156020711 016355 0ustar00phredphred000000 000000 # $Id: DBI.pm 1490648 2013-06-07 13:46:30Z perrin $ package Apache::DBI; use strict; use constant MP2 => (exists $ENV{MOD_PERL_API_VERSION} && $ENV{MOD_PERL_API_VERSION} == 2) ? 1 : 0; BEGIN { if (MP2) { require mod_perl2; require Apache2::Module; require Apache2::RequestUtil; require Apache2::ServerUtil; require ModPerl::Util; } elsif (defined $modperl::VERSION && $modperl::VERSION > 1 && $modperl::VERSION < 1.99) { require Apache; } } use DBI (); use Carp (); require_version DBI 1.00; $Apache::DBI::VERSION = '1.12'; # 1: report about new connect # 2: full debug output $Apache::DBI::DEBUG = 0; #DBI->trace(2); my %Connected; # cache for database handles my @ChildConnect; # connections to be established when a new # httpd child is created my %Rollback; # keeps track of pushed PerlCleanupHandler # which can do a rollback after the request # has finished my %PingTimeOut; # stores the timeout values per data_source, # a negative value de-activates ping, # default = 0 my %LastPingTime; # keeps track of last ping per data_source my $ChildExitHandlerInstalled; # set to true on installation of # PerlChildExitHandler my $InChild; # Check to see if we need to reset TaintIn and TaintOut my $TaintInOut = ($DBI::VERSION >= 1.31) ? 1 : 0; sub debug { print STDERR "$_[1]\n" if $Apache::DBI::DEBUG >= $_[0]; } # supposed to be called in a startup script. # stores the data_source of all connections, which are supposed to be created # upon server startup, and creates a PerlChildInitHandler, which initiates # the connections. Provide a handler which creates all connections during # server startup sub connect_on_init { if (MP2) { if (!@ChildConnect) { my $s = Apache2::ServerUtil->server; $s->push_handlers(PerlChildInitHandler => \&childinit); } } else { Carp::carp("Apache.pm was not loaded\n") and return unless $INC{'Apache.pm'}; if (!@ChildConnect and Apache->can('push_handlers')) { Apache->push_handlers(PerlChildInitHandler => \&childinit); } } # store connections push @ChildConnect, [@_]; } # supposed to be called in a startup script. # stores the timeout per data_source for the ping function. # use a DSN without attribute settings specified within ! sub setPingTimeOut { my $class = shift; my $data_source = shift; my $timeout = shift; # sanity check if ($data_source =~ /dbi:\w+:.*/ and $timeout =~ /\-*\d+/) { $PingTimeOut{$data_source} = $timeout; } } # the connect method called from DBI::connect sub connect { my $class = shift; unshift @_, $class if ref $class; my $drh = shift; my @args = map { defined $_ ? $_ : "" } @_; my $dsn = "dbi:$drh->{Name}:$args[0]"; my $prefix = "$$ Apache::DBI "; # key of %Connected and %Rollback. my $Idx = join $;, $args[0], $args[1], $args[2]; # the hash-reference differs between calls even in the same # process, so de-reference the hash-reference if (3 == $#args and ref $args[3] eq "HASH") { # should we default to '__undef__' or something for undef values? map { $Idx .= "$;$_=" . (defined $args[3]->{$_} ? $args[3]->{$_} : '') } sort keys %{$args[3]}; } elsif (3 == $#args) { pop @args; } # don't cache connections created during server initialization; they # won't be useful after ChildInit, since multiple processes trying to # work over the same database connection simultaneously will receive # unpredictable query results. # See: http://perl.apache.org/docs/2.0/user/porting/compat.html#C__Apache__Server__Starting__and_C__Apache__Server__ReStarting_ if (MP2) { require ModPerl::Util; my $callback = ModPerl::Util::current_callback(); if ($callback !~ m/Handler$/ or $callback =~ m/(PostConfig|OpenLogs)/) { debug(2, "$prefix skipping connection during server startup, read the docu !!"); return $drh->connect(@args); } } else { if ($Apache::ServerStarting and $Apache::ServerStarting == 1) { debug(2, "$prefix skipping connection during server startup, read the docu !!"); return $drh->connect(@args); } } # this PerlChildExitHandler is supposed to disconnect all open # connections to the database if (!$ChildExitHandlerInstalled) { $ChildExitHandlerInstalled = 1; my $s; if (MP2) { $s = Apache2::ServerUtil->server; } elsif (Apache->can('push_handlers')) { $s = 'Apache'; } if ($s) { debug(2, "$prefix push PerlChildExitHandler"); $s->push_handlers(PerlChildExitHandler => \&childexit); } } # this PerlCleanupHandler is supposed to initiate a rollback after the # script has finished if AutoCommit is off. however, cleanup can only # be determined at end of handle life as begin_work may have been called # to temporarily turn off AutoCommit. if (!$Rollback{$Idx}) { my $r; if (MP2) { # We may not actually be in a request, but in (or # equivalent such as startup.pl), in which case this would die. eval { $r = Apache2::RequestUtil->request }; } elsif (Apache->can('push_handlers')) { $r = 'Apache'; } if ($r) { debug(2, "$prefix push PerlCleanupHandler"); $r->push_handlers("PerlCleanupHandler", sub { cleanup($Idx) }); # make sure, that the rollback is called only once for every # request, even if the script calls connect more than once $Rollback{$Idx} = 1; } } # do we need to ping the database ? $PingTimeOut{$dsn} = 0 unless $PingTimeOut{$dsn}; $LastPingTime{$dsn} = 0 unless $LastPingTime{$dsn}; my $now = time; # Must ping if TimeOut = 0 else base on time my $needping = ($PingTimeOut{$dsn} == 0 or ($PingTimeOut{$dsn} > 0 and $now - $LastPingTime{$dsn} > $PingTimeOut{$dsn}) ) ? 1 : 0; debug(2, "$prefix need ping: " . ($needping == 1 ? "yes" : "no")); $LastPingTime{$dsn} = $now; # check first if there is already a database-handle cached # if this is the case, possibly verify the database-handle # using the ping-method. Use eval for checking the connection # handle in order to avoid problems (dying inside ping) when # RaiseError being on and the handle is invalid. if ($Connected{$Idx} and (!$needping or eval{$Connected{$Idx}->ping})) { debug(2, "$prefix already connected to '$Idx'"); # Force clean up of handle in case previous transaction failed to # clean up the handle &reset_startup_state($Idx); return (bless $Connected{$Idx}, 'Apache::DBI::db'); } # either there is no database handle-cached or it is not valid, # so get a new database-handle and store it in the cache delete $Connected{$Idx}; $Connected{$Idx} = $drh->connect(@args); return undef if !$Connected{$Idx}; # store the parameters of the initial connection in the handle set_startup_state($Idx); # return the new database handle debug(1, "$prefix new connect to '$Idx'"); return (bless $Connected{$Idx}, 'Apache::DBI::db'); } # The PerlChildInitHandler creates all connections during server startup. # Note: this handler runs in every child server, but not in the main server. sub childinit { my $prefix = "$$ Apache::DBI "; debug(2, "$prefix PerlChildInitHandler"); %Connected = () if MP2; if (@ChildConnect) { for my $aref (@ChildConnect) { shift @$aref; DBI->connect(@$aref); $LastPingTime{@$aref[0]} = time; } } 1; } # The PerlChildExitHandler disconnects all open connections sub childexit { my $prefix = "$$ Apache::DBI "; debug(2, "$prefix PerlChildExitHandler"); foreach my $dbh (values(%Connected)) { eval { DBI::db::disconnect($dbh) }; if ($@) { debug(2, "$prefix DBI::db::disconnect failed - $@"); } } 1; } # The PerlCleanupHandler is supposed to initiate a rollback after the script # has finished if AutoCommit is off. # Note: the PerlCleanupHandler runs after the response has been sent to # the client sub cleanup { my $Idx = shift; my $prefix = "$$ Apache::DBI "; debug(2, "$prefix PerlCleanupHandler"); my $dbh = $Connected{$Idx}; if ($Rollback{$Idx} and $dbh and $dbh->{Active} and !$dbh->{AutoCommit} and eval {$dbh->rollback}) { debug (2, "$prefix PerlCleanupHandler rollback for '$Idx'"); } delete $Rollback{$Idx}; 1; } # Store the default start state of each dbh in the handle # Note: This uses private_Apache_DBI hash ref to store it in the handle itself my @attrs = qw( AutoCommit Warn CompatMode InactiveDestroy PrintError RaiseError HandleError ShowErrorStatement TraceLevel FetchHashKeyName ChopBlanks LongReadLen LongTruncOk Taint Profile ); sub set_startup_state { my $Idx = shift; foreach my $key (@attrs) { $Connected{$Idx}->{private_Apache_DBI}{$key} = $Connected{$Idx}->{$key}; } if ($TaintInOut) { foreach my $key ( qw{ TaintIn TaintOut } ) { $Connected{$Idx}->{private_Apache_DBI}{$key} = $Connected{$Idx}->{$key}; } } 1; } # Restore the default start state of each dbh sub reset_startup_state { my $Idx = shift; # Rollback current transaction if currently in one $Connected{$Idx}->{Active} and !$Connected{$Idx}->{AutoCommit} and eval {$Connected{$Idx}->rollback}; foreach my $key (@attrs) { $Connected{$Idx}->{$key} = $Connected{$Idx}->{private_Apache_DBI}{$key}; } if ($TaintInOut) { foreach my $key ( qw{ TaintIn TaintOut } ) { $Connected{$Idx}->{$key} = $Connected{$Idx}->{private_Apache_DBI}{$key}; } } 1; } # This function can be called from other handlers to perform tasks on all # cached database handles. sub all_handlers { return \%Connected } # patch from Tim Bunce: Apache::DBI will not return a DBD ref cursor @Apache::DBI::st::ISA = ('DBI::st'); # overload disconnect { package Apache::DBI::db; no strict; @ISA=qw(DBI::db); use strict; sub disconnect { my $prefix = "$$ Apache::DBI "; Apache::DBI::debug(2, "$prefix disconnect (overloaded)"); 1; } ; } # prepare menu item for Apache::Status sub status_function { my($r, $q) = @_; my(@s) = qw(); for (keys %Connected) { push @s, '\n"; } push @s, '
DatasourceUsername
', join('', (split($;, $_))[0,1]), "
'; \@s; } if (MP2) { if (Apache2::Module::loaded('Apache2::Status')) { Apache2::Status->menu_item( 'DBI' => 'DBI connections', \&status_function ); } } else { if ($INC{'Apache.pm'} # is Apache.pm loaded? and Apache->can('module') # really? and Apache->module('Apache::Status')) { # Apache::Status too? Apache::Status->menu_item( 'DBI' => 'DBI connections', \&status_function ); } } 1; __END__ =head1 NAME Apache::DBI - Initiate a persistent database connection =head1 SYNOPSIS # Configuration in httpd.conf or startup.pl: PerlModule Apache::DBI # this comes before all other modules using DBI Do NOT change anything in your scripts. The usage of this module is absolutely transparent ! =head1 DESCRIPTION This module initiates a persistent database connection. The database access uses Perl's DBI. For supported DBI drivers see: http://dbi.perl.org/ When loading the DBI module (do not confuse this with the Apache::DBI module) it checks if the environment variable 'MOD_PERL' has been set and if the module Apache::DBI has been loaded. In this case every connect request will be forwarded to the Apache::DBI module. This checks if a database handle from a previous connect request is already stored and if this handle is still valid using the ping method. If these two conditions are fulfilled it just returns the database handle. The parameters defining the connection have to be exactly the same, including the connect attributes! If there is no appropriate database handle or if the ping method fails, a new connection is established and the handle is stored for later re-use. There is no need to remove the disconnect statements from your code. They won't do anything because the Apache::DBI module overloads the disconnect method. The Apache::DBI module still has a limitation: it keeps database connections persistent on a per process basis. The problem is, if a user accesses a database several times, the http requests will be handled very likely by different processes. Every process needs to do its own connect. It would be nice if all servers could share the database handles, but currently this is not possible because of the distinct memory-space of each process. Also it is not possible to create a database handle upon startup of the httpd and then inherit this handle to every subsequent server. This will cause clashes when the handle is used by two processes at the same time. Apache::DBI has built-in protection against this. It will not make a connection persistent if it sees that it is being opened during the server startup. This allows you to safely open a connection for grabbing data needed at startup and disconnect it normally before the end of startup. With this limitation in mind, there are scenarios, where the usage of Apache::DBI is depreciated. Think about a heavy loaded Web-site where every user connects to the database with a unique userid. Every server would create many database handles each of which spawning a new backend process. In a short time this would kill the web server. Another problem are timeouts: some databases disconnect the client after a certain period of inactivity. The module tries to validate the database handle using the C method of the DBI-module. This method returns true by default. Most DBI drivers have a working C method, but if the driver you're using doesn't have one and the database handle is no longer valid, you will get an error when accessing the database. As a work-around you can try to add your own C method using any database command which is cheap and safe, or you can deactivate the usage of the ping method (see CONFIGURATION below). Here is a generalized ping method, which can be added to the driver module: package DBD::xxx::db; # ====== DATABASE ====== use strict; sub ping { my ($dbh) = @_; my $ret = 0; eval { local $SIG{__DIE__} = sub { return (0); }; local $SIG{__WARN__} = sub { return (0); }; # adapt the select statement to your database: $ret = $dbh->do('select 1'); }; return ($@) ? 0 : $ret; } Transactions: a standard DBI script will automatically perform a rollback whenever the script exits. In the case of persistent database connections, the database handle will not be destroyed and hence no automatic rollback will occur. At a first glance it even seems possible to handle a transaction over multiple requests. But this should be avoided, because different requests are handled by different processes and a process does not know the state of a specific transaction which has been started by another process. In general, it is good practice to perform an explicit commit or rollback at the end of every request. In order to avoid inconsistencies in the database in case AutoCommit is off and the script finishes without an explicit rollback, the Apache::DBI module uses a PerlCleanupHandler to issue a rollback at the end of every request. Note, that this CleanupHandler will only be used, if the initial data_source sets AutoCommit = 0 or AutoCommit is turned off, after the connect has been done (ie begin_work). However, because a connection may have set other parameters, the handle is reset to its initial connection state before it is returned for a second time. This module plugs in a menu item for Apache::Status or Apache2::Status. The menu lists the current database connections. It should be considered incomplete because of the limitations explained above. It shows the current database connections for one specific process, the one which happens to serve the current request. Other processes might have other database connections. The Apache::Status/Apache2::Status module has to be loaded before the Apache::DBI module ! =head1 CONFIGURATION The module should be loaded upon startup of the Apache daemon. Add the following line to your httpd.conf or startup.pl: PerlModule Apache::DBI It is important, to load this module before any other modules using DBI ! A common usage is to load the module in a startup file called via the PerlRequire directive. See eg/startup.pl and eg/startup2.pl for examples. There are two configurations which are server-specific and which can be done upon server startup: Apache::DBI->connect_on_init($data_source, $username, $auth, \%attr) This can be used as a simple way to have apache servers establish connections on process startup. Apache::DBI->setPingTimeOut($data_source, $timeout) This configures the usage of the ping method, to validate a connection. Setting the timeout to 0 will always validate the database connection using the ping method (default). Setting the timeout < 0 will de-activate the validation of the database handle. This can be used for drivers, which do not implement the ping-method. Setting the timeout > 0 will ping the database only if the last access was more than timeout seconds before. For the menu item 'DBI connections' you need to call Apache::Status/Apache2::Status BEFORE Apache::DBI ! For an example of the configuration order see startup.pl. To enable debugging the variable $Apache::DBI::DEBUG must be set. This can either be done in startup.pl or in the user script. Setting the variable to 1, just reports about a new connect. Setting the variable to 2 enables full debug output. =head1 PREREQUISITES =head2 MOD_PERL 2.0 Apache::DBI version 0.96 and later should work under mod_perl 2.0 RC5 and later with httpd 2.0.49 and later. Apache::DBI versions less than 1.00 are NO longer supported. Additionally, mod_perl versions less then 2.0.0 are NO longer supported. =head2 MOD_PERL 1.0 Note that this module needs mod_perl-1.08 or higher, apache_1.3.0 or higher and that mod_perl needs to be configured with the appropriate call-back hooks: PERL_CHILD_INIT=1 PERL_STACKED_HANDLERS=1 Apache::DBI v0.94 was the last version before dual mod_perl 2.x support was begun. It still recommended that you use the latest version of Apache::DBI because Apache::DBI versions less than 1.00 are NO longer supported. =head1 DO YOU NEED THIS MODULE? Note that this module is intended for use in porting existing DBI code to mod_perl, or writing code that can run under both mod_perl and CGI. If you are using a database abstraction layer such as Class::DBI or DBIx::Class that already manages persistent connections for you, there is no need to use this module in addition. (Another popular choice, Rose::DB::Object, can cooperate with Apache::DBI or use your own custom connection handling.) If you are developing new code that is strictly for use in mod_perl, you may choose to use C<< DBI->connect_cached() >> instead, but consider adding an automatic rollback after each request, as described above. =head1 SEE ALSO L, L, L =head1 AUTHORS =over =item * Philip M. Gollucci is currently packaging new releases. Ask Bjoern Hansen packaged a large number of releases. =item * Edmund Mergl was the original author of Apache::DBI. It is now supported and maintained by the modperl mailinglist, see the mod_perl documentation for instructions on how to subscribe. =item * mod_perl by Doug MacEachern. =item * DBI by Tim Bunce =back =head1 COPYRIGHT The Apache::DBI module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Apache-DBI-1.12/eg/startup.pl000755 000765 000765 00000003215 12156020711 016123 0ustar00phredphred000000 000000 #!/usr/local/bin/perl -w # to load this file when the server starts, add this to httpd.conf: # PerlRequire /path/to/startup.pl # make sure we are in a sane environment. $ENV{MOD_PERL} or die "GATEWAY_INTERFACE not Perl!"; use Apache::Registry; use Apache::DBI; #use Apache::AuthDBI; use strict; # optional configuration for Apache::DBI.pm: # choose debug output: 0 = off, 1 = quiet, 2 = chatty #$Apache::DBI::DEBUG = 2; # configure all connections which should be established during server startup. # keep in mind, that if the connect does not succeeed, your server won't start # until the connect times out (database dependent) ! # you may use a DSN with attribute settings specified within #Apache::DBI->connect_on_init("dbi:driver(AutoCommit=>1):database", "userid", "passwd"); # configure the ping behavior of the persistent database connections # you may NOT not use a DSN with attribute settings specified within # $timeout = 0 -> always ping the database connection (default) # $timeout < 0 -> never ping the database connection # $timeout > 0 -> ping the database connection only if the last access # was more than timeout seconds before #Apache::DBI->setPingTimeOut("dbi:driver:database", $timeout); # optional configuration for Apache::AuthDBI.pm: # choose debug output: 0 = off, 1 = quiet, 2 = chatty #$Apache::AuthDBI::DEBUG = 2; # set lifetime in seconds for the entries in the cache #Apache::AuthDBI->setCacheTime(0); # set minimum time in seconds between two runs of the handler which cleans the cache #Apache::AuthDBI->setCleanupTime(-1); # use shared memory of given size for the cache #Apache::AuthDBI->initIPC(50000); 1;