Apache-Wyrd
view release on metacpan or search on metacpan
Minor changes to Inputs and Form interaction to allow zero non-null
values where they would normally be forbidden
Security enhancement where any submitted data containing a string
that can be interpreted as a Wyrd is dropped unless an exception is
explicitly made for it in the initialization data passed to
Apache::Wyrd::DBL by Apache::Wyrd::Handler. This is to prevent
user-submitted data from being executed if it is displayed on a page
Setting the environment variables WYRD_USE_CGI and WYRD_USE_APR can
be used to force the use of either CGI and CGI::Cookie or
Apache::Request and Apache::Cookie as the underlying modules in the
wrapper classes Apache::Wyrd::Request and Apache::Wyrd::Cookie
Apache::Wyrd::Input & Apache::Wyrd::Input::Set more CSS and Java-
Script friendly
Apache::DBL now relies on DBI's connect_cached connection rather
than doing its own caching
Fixed a bug in Apache::Wyrd::Interfaces::Setter where interpolated
variables were not being sorted in some _set_xxxx functions
0.86 (September 22, 2004)
Minor change in Makefile.PL to allow non-blocking of
automated processes
0.85 (September 22, 2004)
Wyrd Framework now works with CGI, not just libapreq/
Apache::Request
New Cookie object to work with either CGI or libapreq
More interactive testing w/survey
Added auto-preloading of values to SQL Forms
Turned off debugging line in Apache::Wyrd which was
accidentally left on
No longer interpret null documents as a SERVER_ERROR
t/TEST.PL
TODO
WISHLIST
Wyrd.pm
Wyrd/Attribute.pm
Wyrd/Bot.pm
Wyrd/BrowserSwitch.pm
Wyrd/CGICond.pm
Wyrd/CGISetter.pm
Wyrd/Chart.pm
Wyrd/Cookie.pm
Wyrd/Datum.pm
Wyrd/DBL.pm
Wyrd/Debug.pm
Wyrd/Defaults.pm
Wyrd/ErrField.pm
Wyrd/ErrTag.pm
Wyrd/FileSize.pm
Wyrd/Form.pm
Wyrd/Form/Preload.pm
Wyrd/Form/Template.pm
version: 0.98
abstract: ~
license: ~
author:
- barry king <wyrd@nospam.wyrdwright.com>
generated_by: ExtUtils::MakeMaker version 6.44
distribution_type: module
requires:
Apache: 1.26
Apache::Constants: 0
Apache::Cookie: 0
Apache::Request: 0
Apache::URI: 0
Apache::Util: 0
BerkeleyDB: 0.23
Class::Singleton: 0
Crypt::Blowfish: 0
DBI: 0
Digest::SHA: 0
HTML::Entities: 0
HTTP::Request::Common: 0
Makefile.PL view on Meta::CPAN
please install Apache::Test v 1.08+ and run the complete test suite
(make test) before contacting the author for support.
__MSG__
sleep 5;
}
}
my $blowfish = 'Crypt::Blowfish';
my $cgi = 'Apache::Request';
my $cookie = 'Apache::Cookie';
if (!$ENV{AUTOMATED_TESTING}) {
print "\nWyrds require Blowfish Crypto, which comes in xs or pure perl.\n";
print "Checking for (faster, preferred) xs version...\n";
eval ('use Crypt::Blowfish');
if ($@) {
print "Falling back on pure perl version.\n";
eval('use Crypt::Blowfish_PP');
$blowfish .= '_PP' unless ($@);
Makefile.PL view on Meta::CPAN
eval ('use Apache::Request');
if ($@) {
print "Falling back on CGI.\n";
eval('use CGI');
$cgi = 'CGI' unless ($@);
print "But I can't find either!\n" if ($@);
} else {
print "Good. You have Apache::Request\n";
}
print "\nWyrds require a Cookie module.\n";
print "Checking for (faster, preferred) Apache::Cookie...\n";
eval ('use Apache::Cookie');
if ($@) {
print "Falling back on CGI::Cookie.\n";
eval('use CGI::Cookie');
$cookie = 'CGI::Cookie' unless ($@);
print "But I can't find either!\n" if ($@);
} else {
print "Good. You have Apache::Cookie\n";
}
}
if ($have_atest) {
print "\nOK... Generating Makefile and TEST...\n";
Apache::TestMM::filter_args();
Apache::TestMM::generate_script('t/TEST');
} else {
use Config;
All the Wyrds have their own documentation in POD form.
The first three give the basics:
Apache::Wyrd::Handler The Handler Module
Apache::Wyrd The abstract self-parsing embeddable object
Apache::Wyrd::DBL The "switchboard" of Apache and DBI connnections
Then the support classes provide much-used functionality:
Apache::Wyrd::Cookie
Apache::Wyrd::Request
Apache::Wyrd::Template
Apache::Wyrd::Attribute
Apache::Wyrd::Lib
Apache::Wyrd::Query
Apache::Wyrd::Lookup
Apache::Wyrd::CGICond
Apache::Wyrd::CGISetter
There are "form-handling" modules:
Wyrd/Cookie.pm view on Meta::CPAN
package Apache::Wyrd::Cookie;
use 5.006;
use strict;
use warnings;
no warnings qw(uninitialized redefine);
our $VERSION = '0.98';
use vars qw(@ISA);
my $have_apr = 1;
if ($ENV{AUTOMATED_TESTING}) {
#If this is a smoker, the APR method is required.
use base qw(Apache::Cookie);
} else {
#set environment variables WYRD_USE_CGI or WYRD_USE_APR
#to force the use of libapreq or CGI
my $force_apr = 0;
my $force_cgi = 0;
if ($ENV{WYRD_USE_CGI}) {
$force_cgi = 1;
}
if ($ENV{WYRD_USE_APR}) {
$force_apr = 1;
}
my $init_error = '';
if (!$force_cgi) {
eval('use Apache::Cookie');
if ($@) {
$init_error = $@;
die "$@" if ($force_apr);
}
}
if ($init_error or $force_cgi) {
eval('use CGI::Cookie');
die "$@" if ($@);
$have_apr = 0;
push @ISA, 'CGI::Cookie';
} else {
push @ISA, 'Apache::Cookie';
}
}
=pod
=head1 NAME
Apache::Wyrd::Cookie - Consistency wrapper for Apache::Cookie and CGI::Cookie
=head1 SYNOPSIS
use Apache::Wyrd::Cookie;
#$req is Apache request object
my $cookie = Apache::Wyrd::Cookie->new(
$req,
-name=>'check_cookie',
-value=>'checking',
-domain=>$req->hostname,
-path=>($auth_path || '/')
);
$cookie->bake;
my %cookie = Apache::Wyrd::Cookie->fetch;
my $g_value = $cookie{'gingerbread'};
=head1 DESCRIPTION
Wrapper for C<Apache::Cookie> or C<CGI:Cookie> cookies. This class is provided
for no other reason than to make the C<new> and C<bake> methods consistent in
their requirements between these modules, which they are not normally.
Otherwise, C<Apache::Wyrd::Cookie> behaves entirely like C<Apache::Cookie> or
C<CGI::Cookie> depending on which is installed and takes the same arguments to
its methods. Please refer to the documentation for those modules.
The normal behavior is to favor C<Apache::Cookie>. If it is not installed, it
will attempt to use CGI. Failing both, it will call C<die()>, causing a server
error. You can force the use of C<Apache::Cookie> or C<CGI::Cookie> by setting
the WYRD_USE_CGI or WYRD_USE_APR environment variables. If the forced module
fails to load, the module will C<die()>, causing a server error. Note that
using these environement variables also affects the behavior of
C<Apache::Wyrd::Cookie>.
=cut
sub new {
my $class = shift;
my @caller = caller;
return CGI::Cookie->new(@_) if ($caller[0] eq 'CGI::Cookie');
my $req = shift;
my $data = {};
if ($have_apr) {
$data = Apache::Cookie->new($req, @_);
} else {
$data = CGI::Cookie->new(@_);
$data->{'_wyrd_req'} = $req;
}
bless $data, $class;
return $data;
}
sub bake {
my $self = shift;
return $self->SUPER::bake if ($have_apr);
my $req = $self->{'_wyrd_req'};
die('Cannot determine the Apache object. Perhaps you are attempting to bake a fetched cookie?')
unless (UNIVERSAL::isa($req, 'Apache'));
$req->err_headers_out->add("Set-Cookie" => ($self->as_string));
$req->headers_out->add("Set-Cookie" => ($self->as_string));
}
=pod
=head1 BUGS/CAVEATS/RESERVED METHODS
UNKNOWN
=head1 AUTHOR
Barry King E<lt>wyrd@nospam.wyrdwright.comE<gt>
=head1 SEE ALSO
=over
=item Apache::Wyrd
General-purpose HTML-embeddable perl object
=item Apache::Cookie
Cookies under Apache
=back
=head1 LICENSE
Copyright 2002-2007 Wyrdwright, Inc. and licensed under the GNU GPL.
See LICENSE under the documentation for C<Apache::Wyrd>.
=cut
Wyrd/Interfaces/GetUser.pm view on Meta::CPAN
#Copyright barry king <barry@wyrdwright.com> and released under the GPL.
#See http://www.gnu.org/licenses/gpl.html#TOC1 for details
use 5.006;
use strict;
use warnings;
no warnings qw(uninitialized);
package Apache::Wyrd::Interfaces::GetUser;
our $VERSION = '0.98';
use Apache::Wyrd::Cookie;
=pod
=head1 NAME
Apache::Wyrd::Interfaces::GetUser - Get User data from Auth service/Auth Cookies
=head1 SYNOPSIS
[in a subclass of Apache::Wyrd::Handler]
sub process {
my ($self) =@_;
$self->{init}->{user} = $self->user('BASENAME::User');
return FORBIDDEN
unless ($self->check_auth($self->{init}->{user}));
Wyrd/Interfaces/GetUser.pm view on Meta::CPAN
my $user_info = $self->req->notes('User');
if ($user_info) {
eval('$user=' . $user_object . '->revive($user_info)');
if ($@) {
$self->_warn("User could not be made from notes because of: $@. Using a blank User.");
}
return $user;
}
#if an Auth handler has not received the request earlier, it may be necessary to build the user out of
#the browser's cookie.
my %cookie = Apache::Wyrd::Cookie->fetch;
my $auth_cookie = $cookie{'auth_cookie'};
my $ip = undef;
if ($auth_cookie) {
$auth_cookie = eval{$auth_cookie->value};
return undef unless ($auth_cookie);
use Apache::Wyrd::Services::CodeRing;
my $cr = Apache::Wyrd::Services::CodeRing->new;
($ip, $auth_cookie) = split(':', $auth_cookie);
$ip = ${$cr->decrypt(\$ip)};
my $ip_ok = 1;
Wyrd/Request.pm view on Meta::CPAN
PerlAddVar as shown in the SYNOPSIS.
If libapreq/C<Apache::Request> is not installed, the object provides a unified
interface to the CGI parameters via the CGI module. When libapreq is not
installed, this behavior will be automitically invoked. If neither are
available, it will call C<die()>, causing a server error.
You can force the use of C<Apache::Request> or C<CGI> by setting the
WYRD_USE_CGI or WYRD_USE_APR environment variables. If the forced module fails
to load, the module will C<die()>, causing a server error. Note that this also
affects the behavior of C<Apache::Wyrd::Cookie>.
=head1 METHODS
I<(format: (returns) name (arguments after self))>
=over
=item (Apache::Wyrd::Request) C<instance> (void)
See C<Apache::Request-E<gt>instance()>. The only difference is the
Wyrd/Services/Auth.pm view on Meta::CPAN
use warnings;
no warnings qw(uninitialized);
package Apache::Wyrd::Services::Auth;
our $VERSION = '0.98';
use Apache::Wyrd::Services::CodeRing;
use Apache::Wyrd::Services::TicketPad;
use Digest::SHA qw(sha256_hex);
use Apache::Wyrd::Request;
use Apache::Constants qw(AUTH_REQUIRED HTTP_SERVICE_UNAVAILABLE REDIRECT DECLINED);
use Apache::Wyrd::Cookie;
use Apache::URI;
use MIME::Base64;
use LWP::UserAgent;
use HTTP::Request::Common;
=pod
=head1 NAME
Apache::Wyrd::Services::Auth - Cookie-based authorization handler
=head1 SYNOPSIS
<Directory /var/www/restricted/>
SetHandler perl-script
PerlHandler Apache::Wyrd::Services::Auth BASENAME::Handler
PerlSetVar LoginFormURL /login.html
PerlSetVar NoCookieURL /cookies.html
PerlSetVar LSKeyURL https://login.someserver.com/login.html
PerlSetVar LSLoginURL https://login.someserver.com/login.html
PerlSetVar LSDownURL /lsdown.html
PerlSetVar AuthPath /
PerlSetVar UserObject BASENAME::User
PerlSetVar ReturnError error_message
PerlSetVar AuthLevel restricted
PerlSetVar Debug 0
PerlSetVar TieAddr 1
</Directory>
Wyrd/Services/Auth.pm view on Meta::CPAN
my $challenge_param = $self->{'challenge_param'} = $req->dir_config('ChallengeParam') || 'challenge';
my $key_url = $self->{'key_url'} = $req->dir_config('LSKeyURL');
my $force_login_server = $req->dir_config('LSForce');
if (!$key_url and ($scheme eq 'http' or $force_login_server)) {
die "Must define LSKeyURL in Apache Config to use Apache::Wyrd::Services::Auth on an insecure port.";
}
unless ($user_object) {
die "Must define UserObject in Apache Config to use Apache::Wyrd::Services::Auth.";
}
my $cr = Apache::Wyrd::Services::CodeRing->new;
my %cookie = Apache::Wyrd::Cookie->fetch;
my $user_info = undef;
my $auth_cookie = $cookie{'auth_cookie'};
my $user = undef;
my $ip = undef;
#if the auth_cookie exists, decrypt it and see if it makes sense
if ($auth_cookie) {
($ip, $auth_cookie) = split(':', eval{$cookie{'auth_cookie'}->value});
$debug && warn("IP before decrypt: " . $ip);
$ip = ${$cr->decrypt(\$ip)};
my $ip_ok = 1;
if ($req->dir_config('TieAddr')) {
my $remote_ip = $req->connection->remote_ip;
if ($remote_ip ne $ip) {
$debug && warn ("Remote ip $remote_ip does not match cookie IP $ip, failing authentication");
$ip_ok = 0;
} else {
$debug && warn ("Remote ip $remote_ip matches cookie IP $ip");
}
}
$debug && warn("Cookie value before decrypt: " . $auth_cookie);
$user_info = ${$cr->decrypt(\$auth_cookie)};
$debug && warn("Cookie value: " . $user_info);
$user=$self->revive($user_info);
if (($user_info and not($user->check_credentials)) or ($auth_cookie and not($user_info)) or ($auth_cookie and not($ip_ok))) {
my $cookie = Apache::Wyrd::Cookie->new(
$req,
-name=>'auth_cookie',
-value=> '',
-domain=>$req->hostname,
-path=> ($auth_path || '/')
);
$cookie->bake;
#TO DO: Make this error message configurable
$challenge_failed = "Your session has expired due to system maintenance. Please log in again.";
$user_info = undef;
Wyrd/Services/Auth.pm view on Meta::CPAN
$challenge_failed = ($user->auth_error || 'Could not process the login because of system maintenance. Please try again.');
}
}
#no auth cookie or challenge. Can the browser accept cookies?
#if this req represents a cookie check, tell the user they must turn on cookies
#if the test cookie is not present.
if ($apr->param('check_cookie')) {
unless ($cookie{'check_cookie'}) {
my $no_cookie_url = $req->dir_config('NoCookieURL');
$no_cookie_url = $scheme . '://' . $req->hostname . $port . $no_cookie_url unless ($no_cookie_url =~ /^http/i);
$req->custom_response(REDIRECT, $no_cookie_url);
return REDIRECT;
}
#if we have no knowledge of whether the browser can accept cookies at this point,
#put it to the test by setting the cookie and forcing the browser to reload this page,
#with the cookie_check variable set.
} elsif($scheme ne 'https') {
unless ($cookie{'check_cookie'}) {
my $cookie = Apache::Wyrd::Cookie->new(
$req,
-name=>'check_cookie',
-value=>'checking',
-domain=>$req->hostname,
-path=>($auth_path || '/')
);
$cookie->bake;
my $query_char = '?';
my $uri = $req->uri;
$uri = Apache::URI->parse($uri);
Wyrd/Services/Auth.pm view on Meta::CPAN
return ($username, $password);
}
sub authorize_user {
my ($self, $req, $user) = @_;
my $debug = $self->{'debug'};
my $cr = Apache::Wyrd::Services::CodeRing->new;
my $auth_path = $req->dir_config('AuthPath');
$debug && warn ("User has been authenticated. Authorizing User and creating Cookie");
my $user_info = $user->store;
$debug && warn ("User info is:\n$user_info");
$req->notes->add('User' => $user_info);
$user_info = $cr->encrypt(\$user_info);
my $ip_addr = $req->connection->remote_ip;
$ip_addr = $cr->encrypt(\$ip_addr);
my $cookie = Apache::Wyrd::Cookie->new(
$req,
-name=>'auth_cookie',
-value=>$$ip_addr . ':' . $$user_info,
-domain=>$req->hostname,
-path=> ($auth_path || '/')
);
$cookie->bake;
}
=pod
Wyrd/Services/Auth.pm view on Meta::CPAN
=item LoginFormURL
Form URL (required)
=item UserObject
Module for the User object which performs authorization (required). See
the C<Apache::Wyrd::User> module.
=item NoCookieURL
URL to send cookie-less browsers to (required)
=item ReturnError
Send error back to the Login URL via the given variable (optional)
=item LSKeyURL
Login Server URL for key (required when a Login Server is being used)
Wyrd/Services/Key.pm view on Meta::CPAN
program.
If Blowfish is not available on your system, it will attempt Blowfish_PP
(pure perl) before failing to compile.
Fixed keys are also possible. The instance method can also accept a
string as an argument to use in place of a randomly-generated key.
In development environments, with frequent server restarts, it is
advisable to use a fixed key to prevent your Form state and Login
Cookies from becoming unusable.
=head1 METHODS
I<(format: (returns) name (arguments after self))>
=over
=item (void) C<instance> ([scalar])
Initialize the Key object. If an optional key is supplied, the cypher
Wyrd/Site/IndexBot.pm view on Meta::CPAN
$counter++;
s/$root//;
unless ($no_skip{$_}) {
next if ($self->{'fastindex'} and ($stats[9] <= $lastindex));
next if $index->skip_file($_);
}
my $url = "http://$hostname$_";
my $response = '';
my $auth_cookie = $self->{'auth_cookie'};
if ($auth_cookie) {
$response = $ua->get($url, Cookie => $auth_cookie);
} else {
$response = $ua->get($url);
}
my $status = $response->status_line;
if ($status =~ /200|OK/) {
print "$counter. $_: OK";
} else {
print "$counter. $_: <span class=\"error\">$status</span>";
system "touch $_" if (-f $_);
}
my $ua = LWP::UserAgent->new(
keep_alive => 1,
timeout => 30,
requests_redirectable => []
);
plan tests => 7;
my $res = $ua->get('http://localhost:8529/restricted/test.html');
my $cookie = $res->header('Set-Cookie');
ok ($cookie =~ /check_cookie=checking/);
$ua->requests_redirectable(['GET']);
$res = $ua->get('http://localhost:8529/restricted/test.html', Cookie => $cookie);
ok ($res->is_success);
my $content = $res->content;
$content =~ m#<ls>(.+)</ls>.*<on_success>(.+)</on_success>.*<ticket>(.+)</ticket>#s;
my $ls = $1;
my $on_success = $2;
my $ticket = $3;
ok ($ls && $on_success && $ticket);
$ua->requests_redirectable([]);
$res = $ua->get("$ls?on_success=$on_success&ticket=$ticket&username=testuser&password=testing123", Cookie => $cookie);
my $new_location = $res->header('Location');
$res = $ua->get($new_location, Cookie => $cookie);
$cookie = $res->header('Set-Cookie');
ok ($cookie =~ /auth_cookie=/);
$new_location = $res->header('Location');
$res = $ua->get($new_location, Cookie => $cookie);
$content = $res->content;
ok ($content =~ /SETEC ASTRONOMY/);
$res = $ua->get('http://localhost:8529/restricted/test.html', Cookie => $cookie);
$content = $res->content;
ok ($content =~ /SETEC ASTRONOMY/);
$res = $ua->get('http://localhost:8529/15.html', Cookie => $cookie);
$content = $res->content;
ok ($content =~ /\b24\b/);
t/conf/extra.conf.in view on Meta::CPAN
SetHandler perl-script
PerlHandler TESTCLIENT::Handler
</Location>
<Location /restricted/>
SetHandler perl-script
PerlHandler Apache::Wyrd::Services::Auth TESTCLIENT::Handler
PerlSetVar LoginFormUrl /loginform.html
PerlSetVar LSKeyURL http://localhost:8529/login.html
PerlSetVar LSLoginURL http://localhost:8529/login.html
PerlSetVar LSDownURL /lsdown.html
PerlSetVar NoCookieURL /cookies.html
PerlSetVar AuthPath /
PerlSetVar Debug 1
PerlSetVar UserObject TESTCLIENT::User
PerlSetVar ReturnError err_message
PerlSetVar AuthLevel test
</Location>
<Location /login.html>
SetHandler perl-script
PerlHandler Apache::Wyrd::Services::LoginServer
PerlSetVar TicketDBFile @ServerRoot@/data/ticketbook.db
( run in 0.752 second using v1.01-cache-2.11-cpan-e9199f4ba4c )