Self-explanatory patch that adds support for setting auth_type and auth_name using modperl_config_insert_request()
Patch to xs/tables/current/ModPerl/FunctionTable.pm included, since
source_scan is still kinda borked.
Index: t/response/TestAPI/access.pm
===================================================================
RCS file: /home/cvspublic/modperl-2.0/t/response/TestAPI/access.pm,v
retrieving revision 1.3
diff -u -I'$Id' -I'$Revision' -r1.3 access.pm
--- t/response/TestAPI/access.pm 11 Apr 2002 11:08:43 -0000 1.3
+++ t/response/TestAPI/access.pm 18 Oct 2002 03:50:57 -0000
@@ -12,7 +12,7 @@
sub handler {
my $r = shift;
- plan $r, tests => 8;
+ plan $r, tests => 10;
$r->allow_methods(1, qw(GET POST));
@@ -28,7 +28,15 @@
ok $r->auth_name eq 'modperl';
+ $r->auth_name('modperl_test');
+ ok $r->auth_name eq 'modperl_test';
+ $r->auth_name('modperl');
+
ok $r->auth_type eq 'none';
+
+ $r->auth_type('Basic');
+ ok $r->auth_type eq 'Basic';
+ $r->auth_type('none');
ok !$r->some_auth_required;
Index: todo/api.txt
===================================================================
RCS file: /home/cvspublic/modperl-2.0/todo/api.txt,v
retrieving revision 1.26
diff -u -I'$Id' -I'$Revision' -r1.26 api.txt
--- todo/api.txt 5 Sep 2002 01:52:26 -0000 1.26
+++ todo/api.txt 18 Oct 2002 03:50:57 -0000
@@ -53,9 +53,6 @@
with fd's which aren't files and of unknown length, therefore it cannot
be used for implementing 1.x compatible send_fd.
-$r->auth_{name,type}:
- are not yet writable. need wrappers to call modperl_config_insert_request
-
$r->get_basic_auth_pw:
does not yet default AuthType and AuthName as 1.x does
(should use modperl_config_insert_request to do so)
Index: xs/Apache/Access/Apache__Access.h
===================================================================
RCS file: /home/cvspublic/modperl-2.0/xs/Apache/Access/Apache__Access.h,v
retrieving revision 1.4
diff -u -I'$Id' -I'$Revision' -r1.4 Apache__Access.h
--- xs/Apache/Access/Apache__Access.h 5 May 2001 02:16:01 -0000 1.4
+++ xs/Apache/Access/Apache__Access.h 18 Oct 2002 03:50:57 -0000
@@ -78,4 +78,46 @@
}
}
-
+static MP_INLINE
+const char *mpxs_Apache__RequestRec_auth_type(pTHX_ request_rec *r,
+ char *type)
+{
+ AV *config = Nullav;
+ const char *errmsg = NULL;
+
+ if (NULL != type) {
+ config = newAV();
+ av_push(config, newSVpvf("AuthType %s", type));
+ errmsg =
+ modperl_config_insert_request(aTHX_ r,
+ newRV_noinc((SV *)config),
+ r->filename, OR_AUTHCFG);
+ if (errmsg) {
+ Perl_warn(aTHX_ "Can't change AuthType to '%s'\n", type);
+ }
+ SvREFCNT_dec((SV *)config);
+ }
+ return ap_auth_type(r);
+}
+
+static MP_INLINE
+const char *mpxs_Apache__RequestRec_auth_name(pTHX_ request_rec *r,
+ char *name)
+{
+ AV *config = Nullav;
+ const char *errmsg = NULL;
+
+ if (NULL != name) {
+ config = newAV();
+ av_push(config, newSVpvf("AuthName %s", name));
+ errmsg =
+ modperl_config_insert_request(aTHX_ r,
+ newRV_noinc((SV *)config),
+ r->filename, OR_AUTHCFG);
+ if (errmsg) {
+ Perl_warn(aTHX_ "Can't change AuthName to '%s'\n", name);
+ }
+ SvREFCNT_dec((SV *)config);
+ }
+ return ap_auth_name(r);
+}
Index: xs/maps/apache_functions.map
===================================================================
RCS file: /home/cvspublic/modperl-2.0/xs/maps/apache_functions.map,v
retrieving revision 1.58
diff -u -I'$Id' -I'$Revision' -r1.58 apache_functions.map
--- xs/maps/apache_functions.map 27 Aug 2002 04:28:38 -0000 1.58
+++ xs/maps/apache_functions.map 18 Oct 2002 03:50:57 -0000
@@ -136,8 +136,8 @@
ap_satisfies
#MODULE=Apache::Auth
- ap_auth_name
- ap_auth_type
+ mpxs_Apache__RequestRec_auth_name | | r, name=NULL
+ mpxs_Apache__RequestRec_auth_type | | r, type=NULL
ap_get_basic_auth_pw | MPXS_ | r
ap_note_auth_failure
ap_note_basic_auth_failure
Index: xs/tables/current/ModPerl/FunctionTable.pm
===================================================================
RCS file: /home/cvspublic/modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm,v
retrieving revision 1.85
diff -u -I'$Id' -I'$Revision' -r1.85 FunctionTable.pm
--- xs/tables/current/ModPerl/FunctionTable.pm 5 Sep 2002 01:49:08 -0000 1.85
+++ xs/tables/current/ModPerl/FunctionTable.pm 18 Oct 2002 03:50:58 -0000
@@ -4953,6 +4953,42 @@
},
{
'return_type' => 'const char *',
+ 'name' => 'mpxs_Apache__RequestRec_auth_name',
+ 'args' => [
+ {
+ 'type' => 'PerlInterpreter *',
+ 'name' => 'my_perl'
+ },
+ {
+ 'type' => 'request_rec *',
+ 'name' => 'r'
+ },
+ {
+ 'type' => 'char *',
+ 'name' => 'name'
+ }
+ ]
+ },
+ {
+ 'return_type' => 'const char *',
+ 'name' => 'mpxs_Apache__RequestRec_auth_type',
+ 'args' => [
+ {
+ 'type' => 'PerlInterpreter *',
+ 'name' => 'my_perl'
+ },
+ {
+ 'type' => 'request_rec *',
+ 'name' => 'r'
+ },
+ {
+ 'type' => 'char *',
+ 'name' => 'type'
+ }
+ ]
+ },
+ {
+ 'return_type' => 'const char *',
'name' => 'mpxs_Apache__RequestRec_add_config',
'args' => [
{
--------------------------------------------------------------------------------
Philippe M. Chiasson /gozer\@(cpan|ectoplasm)\.org/ 88C3A5A5
(122FF51B/C634E37B)
http://gozer.ectoplasm.org/ F9BF E0C2 480E 7680 1AE5 3631 CB32 A107
88C3 A5A5
Q: It is impossible to make anything foolproof because fools are so
ingenious.
perl
-e'$$=\${gozer};{$_=unpack(P7,pack(L,$$));/^JAm_pH\n$/&&print||$$++&&redo}'
signature.asc
Description: This is a digitally signed message part
