From: Mike Taylor Date: Tue, 9 Jul 2013 11:19:26 +0000 (+0100) Subject: More mod_perl support for MKWS web-server into tools area X-Git-Tag: 0.9.1~305^2~21 X-Git-Url: http://git.indexdata.com/?p=mkws-moved-to-github.git;a=commitdiff_plain;h=641e2f9f931b5440ce86af8f5d67df296a21192c More mod_perl support for MKWS web-server into tools area --- diff --git a/etc/mod_perl/MyApache2/CopyCookie.pm b/etc/mod_perl/MyApache2/CopyCookie.pm deleted file mode 100644 index 3e29647..0000000 --- a/etc/mod_perl/MyApache2/CopyCookie.pm +++ /dev/null @@ -1,41 +0,0 @@ -package MyApache2::CopyCookie; - -use Apache2::Filter (); -use Apache2::RequestRec (); -use APR::Table (); - -use Apache2::Const -compile => qw(OK); - -use constant BUFF_LEN => 1024; - -sub handler { - my $f = shift; - - # If the server generated a new cookie, make it available in a - # header other than the magic "Cookie" that clients can't read. - my $ho = $f->r->headers_out; - my $cookie = $ho->get('Set-Cookie'); - if (defined $cookie && $cookie ne "") { - $ho->set('X-Set-Cake', $cookie); - } - - # If the client sent an existing cookie as X-Cake, but didn't - # set Cookie, copy the former to the latter. - my $hi = $f->r->headers_in; - $cookie = $hi->get('Cookie'); - if (!defined $cookie || $cookie eq "") { - $cookie = $hi->get('X-Cake'); - if (defined $cookie && $cookie ne "") { - warn "copying X-Cake '$cookie' to Cookie"; - $hi->set('Cookie', $cookie); - } - } - - while ($f->read(my $buffer, BUFF_LEN)) { - $f->print($buffer); - } - - return Apache2::Const::OK; -} - -1; diff --git a/etc/mod_perl/MyApache2/SetACAO.pm b/etc/mod_perl/MyApache2/SetACAO.pm deleted file mode 100644 index 66334fc..0000000 --- a/etc/mod_perl/MyApache2/SetACAO.pm +++ /dev/null @@ -1,30 +0,0 @@ -package MyApache2::SetACAO; - -use Apache2::Filter (); -use Apache2::RequestRec (); -use APR::Table (); - -use Apache2::Const -compile => qw(OK); - -use constant BUFF_LEN => 1024; - -sub handler { - my $f = shift; - - # If the client generated an Origin header, echo its content back - # in an ACAO header. This is better than just using *, since it - # doesnt prevent credentials from being accepted. - my $origin = $f->r->headers_in->get('Origin'); - if (defined $origin && $origin ne "") { - $f->r->headers_out->set('Access-Control-Allow-Origin', $origin); - warn "MyApache2::SetACAO copied Origin '$origin' to ACAO"; - } - - while ($f->read(my $buffer, BUFF_LEN)) { - $f->print($buffer); - } - - return Apache2::Const::OK; -} - -1; diff --git a/tools/mod_perl/MyApache2/CopyCookie.pm b/tools/mod_perl/MyApache2/CopyCookie.pm new file mode 100644 index 0000000..3e29647 --- /dev/null +++ b/tools/mod_perl/MyApache2/CopyCookie.pm @@ -0,0 +1,41 @@ +package MyApache2::CopyCookie; + +use Apache2::Filter (); +use Apache2::RequestRec (); +use APR::Table (); + +use Apache2::Const -compile => qw(OK); + +use constant BUFF_LEN => 1024; + +sub handler { + my $f = shift; + + # If the server generated a new cookie, make it available in a + # header other than the magic "Cookie" that clients can't read. + my $ho = $f->r->headers_out; + my $cookie = $ho->get('Set-Cookie'); + if (defined $cookie && $cookie ne "") { + $ho->set('X-Set-Cake', $cookie); + } + + # If the client sent an existing cookie as X-Cake, but didn't + # set Cookie, copy the former to the latter. + my $hi = $f->r->headers_in; + $cookie = $hi->get('Cookie'); + if (!defined $cookie || $cookie eq "") { + $cookie = $hi->get('X-Cake'); + if (defined $cookie && $cookie ne "") { + warn "copying X-Cake '$cookie' to Cookie"; + $hi->set('Cookie', $cookie); + } + } + + while ($f->read(my $buffer, BUFF_LEN)) { + $f->print($buffer); + } + + return Apache2::Const::OK; +} + +1; diff --git a/tools/mod_perl/MyApache2/SetACAO.pm b/tools/mod_perl/MyApache2/SetACAO.pm new file mode 100644 index 0000000..66334fc --- /dev/null +++ b/tools/mod_perl/MyApache2/SetACAO.pm @@ -0,0 +1,30 @@ +package MyApache2::SetACAO; + +use Apache2::Filter (); +use Apache2::RequestRec (); +use APR::Table (); + +use Apache2::Const -compile => qw(OK); + +use constant BUFF_LEN => 1024; + +sub handler { + my $f = shift; + + # If the client generated an Origin header, echo its content back + # in an ACAO header. This is better than just using *, since it + # doesnt prevent credentials from being accepted. + my $origin = $f->r->headers_in->get('Origin'); + if (defined $origin && $origin ne "") { + $f->r->headers_out->set('Access-Control-Allow-Origin', $origin); + warn "MyApache2::SetACAO copied Origin '$origin' to ACAO"; + } + + while ($f->read(my $buffer, BUFF_LEN)) { + $f->print($buffer); + } + + return Apache2::Const::OK; +} + +1;