Apache-Wyrd
view release on metacpan or search on metacpan
Wyrd/DBL.pm view on Meta::CPAN
the param/cookie subsystem (CGI or Apache::Request object initialized by a Apache::Wyrd::Request object);
=item dba
database application. Should be the name of a DBI::DBD driver.
=item database
database name (to connect to)
=item db_password
database password
=item db_username
database user name
=item loglevel
Logging level, per Apache::Wyrd object
=item globals
Wyrd/DBL.pm view on Meta::CPAN
complain("invalid global data given to Das Blinkenlights -- Ignored");
$$init{'globals'} = {};
}
my @standard_params = qw(
atime
base_class
blksize
blocks
ctime
database
db_password
db_username
dba
dev
file_path
gid
globals
ino
logfile
loglevel
mode
Wyrd/DBL.pm view on Meta::CPAN
Database handle object. Collects database information from the initialization
data and calls _init_db with it.
=cut
sub dbh {
my ($self) = shift;
my $dba = $self->{'dba'};
my $db = $self->{'database'};
my $uname = $self->{'db_username'};
my $pw = $self->{'db_password'};
my $dbh = $self->_init_db($dba, $db, $uname, $pw);
return $dbh if ($dbh);
$self->log_bug('dbh was requested from DBL but no database could be initialized');
return;
}
=pod
=item (Apache) C<req> (void)
Wyrd/DBL.pm view on Meta::CPAN
my $scheme = 'http:';
$scheme = 'https:' if ($ENV{'HTTPS'} eq 'on');
return $scheme . '//' . $self->req->hostname . $self->req->parsed_uri->unparse;
}
=pod
=item (internal) C<_init_db> (scalar, scalar, scalar, scalar);
open the DB connection. Accepts a database type, a database name, a username,
and a password. Defaults to a mysql database. Sets the dbh parameter and the
dbh_ok parameter if the database connection was successful. Meant to be called
from C<dbh>. As of version 0.97 calls connect_cached instead of attempting to
maintain a cached connection itself.
=cut
sub _init_db {
my ($self, $dba, $database, $db_uname, $db_passwd) = @_;
my $dbh = undef;
Wyrd/Defaults.pm view on Meta::CPAN
=pod
=head1 NAME
Apache::Wyrd::Defaults - Default data for a Form Wyrd
=head1 SYNOPSIS
<BASENAME::SQLForm index="user_id" table="users">
<BASENAME::Form::Template name="password">
<BASENAME::Form::Preload>
<BASENAME::Defaults>
select 'root' as user_id;
</BASENAME::Defaults>
<BASENAME::Query>
select user_id from users where name='Groucho'
</BASENAME::Query>
</BASENAME::Form::Preload>
<b>Enter Password:</b><br>
<BASENAME::Input name="password" type="password" />
<BASENAME::Input name="user_id" type="hidden" />
</BASENAME::Form::Template>
<BASENAME::Form::Template name="result">
<H1>Status: $:_status</H1>
<HR>
<P>$:_message</P>
</BASENAME::Form::Template>
</BASENAME::SQLForm>
=head1 DESCRIPTION
Wyrd/Form/Preload.pm view on Meta::CPAN
=pod
=head1 NAME
Apache::Wyrd::Form::Preload - Wyrd to load a Form Wyrd with existing data
=head1 SYNOPSIS
<BASENAME::SQLForm index="user_id" table="users">
<BASENAME::Form::Template name="password">
<BASENAME::Form::Preload>
<BASENAME::Defaults>
select 'root' as user_id;
</BASENAME::Defaults>
<BASENAME::Query>
select user_id from users where name='Groucho'
</BASENAME::Query>
</BASENAME::Form::Preload>
<b>Enter Password:</b><br>
<BASENAME::Input name="password" type="password" />
<BASENAME::Input name="user_id" type="hidden" />
</BASENAME::Form::Template>
<BASENAME::Form::Template name="result">
<H1>Status: $:_status</H1>
<HR>
<P>$:_message</P>
</BASENAME::Form::Template>
</BASENAME::SQLForm>
=head1 DESCRIPTION
Wyrd/Form/Template.pm view on Meta::CPAN
=pod
=head1 NAME
Apache::Wyrd::Form::Template - Sub-form unit Wyrd
=head1 SYNOPSIS
<BASENAME::SQLForm index="user_id" table="users">
<BASENAME::Form::Template name="password">
<BASENAME::Form::Preload>
<BASENAME::Defaults>
select 'root' as user_id;
</BASENAME::Defaults>
<BASENAME::Query>
select user_id from users where name='Groucho'
</BASENAME::Query>
</BASENAME::Form::Preload>
<b>Enter Password:</b><br>
<BASENAME::Input name="password" type="password" />
<BASENAME::Input name="user_id" type="hidden" />
</BASENAME::Form::Template>
<BASENAME::Form::Template name="result">
<H1>Status: $:_status</H1>
<HR>
<P>$:_message</P>
</BASENAME::Form::Template>
</BASENAME::SQLForm>
=head1 DESCRIPTION
Wyrd/Input.pm view on Meta::CPAN
=head1 SYNOPSIS
<BASENAME::Input type="text" name="foo" flags="required" />
<BASENAME::Input type="textarea" name="desc" height="100" width="100">
This is the default text
</BASENAME::Input>
<BASENAME::Input type="hidden" name="name" value="lenore" />
<BASENAME::Input type="password" name="name" size="10" />
sub _startup_integer {
my ($self, $value, $params) = @_;
$self->{'_datum'} ||=
Apache::Wyrd::Datum::Integer->new($self->{'value'}, $params);
$self->{'_template'} ||= '<input type="text" name="$:name" ' .
'value="$:value"?:size{ size="$:size"}?:id{ id="$:id"}' .
'?:readonly{ readonly}>';
$self->{'_smart_type'} = 'text';
}
Wyrd/Input.pm view on Meta::CPAN
Input object is meant to replace, in most cases, the input HTML objects:
=over
=item *
text inputs
=item *
password inputs
=item *
textarea inputs
=item *
hidden inputs
=back
For these, set the type attribute to B<text>, B<password>, B<textarea>,
and B<hidden> respectively. Another hybrid input is B<plaintext>, which
both shows the text and includes it in the form as a hidden input. For
other input types, such as radiobuttons, checkboxes, selection sets,
etc., see C<Apache::Wyrd::Input::Set>.
The Input does its work in the C<_format_output> phase. If given a
type of "foo", it will first attempt to match it to one of the standard
types, then look for a C<startup_foo> method and if it finds it, will call
the method. This is to allow derived Input objects to initialize
builtins, if needed, without re-implementing the whole _format_output
Wyrd/Input.pm view on Meta::CPAN
I<(format: (returns) name (arguments after self))>
=over
=item (scalar) C<name/type/value/description/param> (void)
Input has read-only methods for C<name>, C<type>, C<value>,
C<description>, C<triggers>, and C<param>. The C<param> attribute is optional for
Inputs which might need to use another name than the CGI variable of
their associated HTML input, such as to use 'username' and 'password' when
the browser may attempt to auto-fill these values.
Note that the C<value> call gets the current value of the input from the
underlying C<_datum> object, and not from it's temporary storage under
the C<_value> attribute. This allows the Datum to be independent of the
temporary value of the Input.
=cut
sub name {
Wyrd/Input.pm view on Meta::CPAN
$value =~ s/\$\x00:/\$:/g;
return $value;
}
=pod
=item (scalar) C<_template_foo> (scalar)
the C<_template> methods should provide an
C<Apache::Wyrd::Interfaces::Setter>-style template for a given input.
Built-in templates are text, textarea, password
=cut
sub _template_text {
return '<input type="text" name="$:param" value="$:value"?:size{ size="$:size"}?:class{ class="$:class"}?:style{ style="$:style"}?:id{ id="$:id"}?:maxlength{ maxlength="$:maxlength"}?:tabindex{ tabindex="$:tabindex"}?:accesskey{ accesskey="$:tabinde...
}
sub _template_textarea {
return '<textarea name="$:param"?:cols{ cols="$:cols"}?:rows{ rows="$:rows"}?:wrap{ wrap="$:wrap"}?:id{ id="$:id"}?:class{ class="$:class"}?:style{ style="$:style"}?:tabindex{ tabindex="$:tabindex"}?:accesskey{ accesskey="$:accesskey"}?:onblur{ onbl...
}
sub _template_password {
return '<input type="password" name="$:param" value="$:value"?:size{ size="$:size"}?:id{ id="$:id"}?:maxlength{ maxlength="$:maxlength"}?:class{ class="$:class"}?:style{ style="$:style"}?:tabindex{ tabindex="$:tabindex"}?:accesskey{ accesskey="$:tab...
}
sub _template_hidden {
return '<input type="hidden" name="$:param" value="$:value">';
}
=pod
=back
Wyrd/Input.pm view on Meta::CPAN
$self->_flags->escape(1);
$self->{'value'} ||= $self->_data;#value may be enclosed in a textarea input
$self->{'_datum'} ||= Apache::Wyrd::Datum::Text->new($self->{'value'}, \%params);
if ($self->{'_template'} !~ /<textarea/) {
$self->{'_template'} = $self->_template_textarea;
}
} elsif ($type eq 'hidden') {
$self->_flags->escape(1);
$self->{'_datum'} ||= Apache::Wyrd::Datum::Text->new($self->{'value'}, \%params);
$self->{'_template'} ||= $self->_template_hidden;
} elsif ($type eq 'password') {
$self->{'_datum'} ||= Apache::Wyrd::Datum::Text->new($self->{'value'}, \%params);
$self->{'_template'} ||= $self->_template_password;
} elsif ($type eq 'plaintext') {
$self->{'_datum'} ||= Apache::Wyrd::Datum::Text->new($self->{'value'}, \%params);
$self->{'_template'} ||= '$:value<input type="hidden" name="$:name" value="$:value">';
} else {
if ($self->can('_startup_' . $type)) {
eval('$self->_startup_' . $type .'($self->{\'value\'}, \\%params)');
$self->_raise_exception($@ . " while trying to create an input of type '$type'") if ($@);
} else {
$self->_raise_exception("Don't know how to handle a '$type'");
}
Wyrd/SQLForm.pm view on Meta::CPAN
=pod
=head1 NAME
Apache::Wyrd::SQLForm - General Form Wyrd for editing data in SQL
=head1 SYNOPSIS
<BASENAME::SQLForm index="user_id" table="users">
<BASENAME::Form::Template name="password">
<BASENAME::Form::Preload>
<BASENAME::Defaults>
select 'root' as user_id;
</BASENAME::Defaults>
<BASENAME::Query>
select user_id from users where name='Groucho'
</BASENAME::Query>
</BASENAME::Form::Preload>
<b>Enter Password:</b><br>
<BASENAME::Input name="password" type="password" />
<BASENAME::Input name="user_id" type="hidden" />
</BASENAME::Form::Template>
<BASENAME::Form::Template name="result">
<H1>Status: $:_status</H1>
<HR>
<P>$:_message</P>
</BASENAME::Form::Template>
</BASENAME::SQLForm>
=head1 DESCRIPTION
Wyrd/Services/Auth.pm view on Meta::CPAN
PerlSetVar TieAddr 1
</Directory>
=head1 DESCRIPTION
Auth provides a secure cookies-based login system for a Wyrd-enabled server
that might not itself be equipped with SSL. It can do so if provided a
connection to an SSL-enabled Apache server with an
C<Apache::Wyrd::Services::LoginServer> available on a secure port. It uses
a standard SSL channel to circumvent an unauthorized party from obtaining
login credentials (username/password) by packet-sniffing.
To do so, it maintains a cookie-based authorization scheme which is
implemented using stacked handlers. It handles authorization by login
and/or cookie, and passes the user information to handlers down the
stack via mod_perl's C<notes> table. The Auth module should be the
first handler in a chain of handlers.
The Auth Module first checks for a "challenge" variable under CGI which
it expects to contain a username/password pair encrypted via it's own
private encryption key (see the use of the
C<Apache::Wyrd::Services::Key> object in relation to the
C<Apache::Wyrd::Services::CodeRing> object). This challenge is
generated by a LoginServer (see below), and is part of the regular login
sequence. If this variable is provided, it will attempt to create a
user object from it and set a cookie on the browser (B<auth_cookie>)
which keeps this user object stored for later use.
If the challenge is not found, it checks for a cookie called
auth_cookie, and decrypts it, passing it on in an XML notes item called
Wyrd/Services/Auth.pm view on Meta::CPAN
a page explaining that the login server is down and authorization cannot
proceed.
If the session succeeds, it will encode the URL the browser originally
requested so that it may be redirected to that URL on successful login.
This encoded URL, an authorization URL, and the encrypted key it gave
the login server is given to the browser as a GET-request redirection to
a login page. On the login page, the encoded URL and the encrypted key
are to be used as hidden fields to pass to the login url which is given
as the action attribute of the login form. The login form has, at a
minimum, a username and password. These are all submitted to the login
server via SSL.
The login server will then decrypt the encrypted key, use that key to
encrypt the login information, and send that information to the
originally-requested URL via the challenge CGI variable. As the Auth
object will again be in the stack, it will receive the challenge per the
first paragraph of this description.
Under SSL, instead, the Auth module checks for a user with appropriate
clearance. Not finding one, it will expect to find the username and password
under CGI variables of those names. If found, it will attempt athentication.
If this fails, as above, the browser will be redirected to the login URL.
Instead of a LoginServer, however, the login form will be expected to attempt
the URL it was refused in the first place, and will return the browser
to the login page on each subsequent failure until a login succeeds.
Note that under SSL, since CGI variables are scanned for authentication
information, any CGI variables being passed prior to authentication will be
lost in the subsequent re-direction which checks for browser cookie acceptance.
If you wish to avoid this behavior, set the LSForce PerlVar directive to 1.
Wyrd/Services/Auth.pm view on Meta::CPAN
my $apr = Apache::Wyrd::Request->instance($req);
#is there a failed challenge?
$challenge_failed = ($apr->param('ls_error') || '');
#is there a challenge variable from the Login Server?
my $challenge = $apr->param($challenge_param);
$apr->param($challenge_param, '');
if ($challenge) {
$debug && warn('challenge ' . "'$challenge'" . ' decrypts to ' . join(':', $self->decrypt_challenge($challenge)));
my ($username, $password) = $self->decrypt_challenge($challenge);
if ($username) {
my $user = $self->initialize({username => $username, password => $password});
if ($user->login_ok) {
$self->authorize_user($req, $user);
my $uri = $req->uri;
$uri = Apache::URI->parse($uri);
#remove the challenge portion of the query string
my $query_string = $uri->query;
$query_string =~ s/challenge=[0123456789abcdefABCDEF:]+\&?//g;
$query_string =~ s/\&$//;
$query_string = '?' . $query_string if ($query_string);
my $self = $scheme . '://' . $req->hostname . $port . $req->uri . $query_string;
Wyrd/Services/Auth.pm view on Meta::CPAN
$req->custom_response(REDIRECT, $redirect);
return REDIRECT;
} else {
die "Must define LoginFormURL in Apache Config to use Apache::Wyrd::Services::Auth";
}
}
#Since we are using SSL, we can accept login information as normal CGI params.
} else {
my $username = $apr->param('username');
my $password = $apr->param('password');
my $login_failed = '';
if ($username) {
my $user = $self->initialize({username => $username, password => $password});
if ($user->login_ok) {
$self->authorize_user($req, $user);
my $uri = $req->uri;
$uri = Apache::URI->parse($uri);
my $redirect = $scheme . '://' . $req->hostname . $port . $req->uri . '?check_cookie=yes';
$debug && warn('Setting a cookie, with redirect going to ' . $redirect);
$req->custom_response(REDIRECT, $redirect);
return REDIRECT;
}
$login_failed = 'Login failed. Please check your username and password.';
$debug && warn('Login failed.');
} else {
$debug && warn('Login was not provided.');
}
my $use_error = $req->dir_config('ReturnError');
my $login_url = $req->dir_config('LoginFormURL');
$login_url = $scheme . '://' . $req->hostname . $port . $login_url unless ($login_url =~ /^http/i);
my $ls_url = $scheme . '://' . $req->hostname . $port . $req->uri;
if ($login_url) {
my $uri = $req->uri;
Wyrd/Services/Auth.pm view on Meta::CPAN
#TO DO: place this into a safe of some sort
eval('$user = ' . $user_object . '->revive($user_info)');
return $user;
}
sub initialize {
my ($self, $init) = @_;
my $user = undef;
my $username=$init->{'username'};
my $password=$init->{'password'};
my $user_object = $self->{'user_object'};
eval "use $user_object;";
eval('$user = ' . $user_object . '->new({username => $username, password => $password})');
die $@ if ($@);
return $user;
}
sub generate_ticket {
my ($self) = @_;
my $debug = $self->{'debug'};
my $ticketfile = $self->{'ticketfile'};
Wyrd/Services/Auth.pm view on Meta::CPAN
my ($ticket, $data) = split ':', $challenge;
#find the key for decrypting the data;
$debug && warn('finding ' . $ticket);
my $pad = Apache::Wyrd::Services::TicketPad->new($ticketfile);
my $key = $pad->find($ticket);
$debug && warn "found key $key";
$key = Apache::Util::unescape_uri($key);
my $cr = Apache::Wyrd::Services::CodeRing->new({key => $key});
my ($username, $password) = split ("\t", ${$cr->decrypt(\$data)});
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");
Wyrd/Services/Auth.pm view on Meta::CPAN
Login Server URL for key (required when a Login Server is being used)
=item LSLoginURL
Login Server URL for login (when a Login Server is being used)
=item LSForce
Force the use of a Login Server on an HTTPS connection rather than attempting
to authenticate directly through the username and password CGI variables.
=item LSDownURL
URL to redirect to when Login Server is down. (optional, but
recommended)
=item Debug
Dump debugging information to the Error Log (0 for default no, 1 for yes).
Note that if the log is not secure, this may compromise the users'
Wyrd/Services/LoginServer.pm view on Meta::CPAN
=head1 DESCRIPTION
The Login Server provides SSL encryption for a login to a
Apache::Wyrd::Auth module when it must run on an insecure port. This
behavior is described in the documentation for
C<Apache::Wyrd::Services::Auth>.
It uses the TicketPad module to keep a cache of 100 recent tickets. If
presented with a POST request with a 'key' parameter, it stores the key
and returns OK. If presented with an authorization set (on_success,
[on_fail], user, password, ticket), it returns the data to the server
via a redirected GET request with the challenge parameter set to the
encrypted data.
The TicketPad has a limited capacity, and old tickets are removed as new
ones are added. If the authorization request is so stale it asks for a
ticket that has been discarded, the LoginServer returns the status
HTTP_SERVICE_UNAVAILABLE.
All other accesses fail with an AUTH_REQUIRED
Wyrd/Services/LoginServer.pm view on Meta::CPAN
}
my $content = $response->content;
$content =~ s/\s*//gsm;
if ($content =~ /http/) {
$req->custom_response(HTTP_MOVED_TEMPORARILY, $content);
return HTTP_MOVED_TEMPORARILY;
}
$ticket = $content;
}
my $user = $apr->param('username') || 'anonymous';
my $password = $apr->param('password');
#find key
$debug && warn('finding ' . $ticket);
my $pad = Apache::Wyrd::Services::TicketPad->new($ticketfile);
$key = $pad->find($ticket);
unless ($key) {
my $joiner = '?';
$joiner = '&' if ($fail_url =~ /\?/);
$debug && warn("key could not be found. Server key has probably been lost due to a re-initializtion of Apache::Wyrd::Services::CodeRing. Nothing for it but to send the browser back.");
$req->custom_response(HTTP_MOVED_TEMPORARILY, "$fail_url$joiner$use_error" . '=Login%20Server%20has%20been%20re-started%20please%20try%20again.');
return HTTP_MOVED_TEMPORARILY;
}
my $joiner = '?';
$joiner = '&' if ($success_url =~ /\?/);
$debug && warn("found the key $key");
$key = Apache::Util::unescape_uri($key);
my $ex_cr = Apache::Wyrd::Services::CodeRing->new({key => $key});
$debug && warn("Generated a new decryption ring with the found key");
my $data = "$user\t$password";
$data = $ex_cr->encrypt(\$data);
$debug && warn("Data encrypted with the key");
$req->custom_response(HTTP_MOVED_TEMPORARILY, "$success_url" . $joiner . 'challenge=' . $ticket . ':' . $$data);
$debug && warn("loginserver has set the challenge to $$data");
return HTTP_MOVED_TEMPORARILY;
} else {
return AUTH_REQUIRED
}
}
Wyrd/Services/MySQLIndex.pm view on Meta::CPAN
=pod
=head1 NAME
Apache::Wyrd::Services::MySQLIndex - MySQL version of Index
=head1 SYNOPSIS
sub new {
my ($class) = @_;
my $dbh = DBI->connect('DBI:mysql:dbname', 'username', 'password');
my $init = {
dbh => $dbh,
debug => 0,
attributes => [qw(doctype section parent)],
maps => [qw(tags children)],
};
return &Apache::Wyrd::Site::MySQLIndex::new($class, $init);
}
my @subject_is_foobar = $index->word_search('foobar', 'subjects');
Wyrd/Site/Login.pm view on Meta::CPAN
=head1 NAME
Apache::Wyrd::Site::Login - HTML Interface for Apache::Wyrd::Services::(Pre)Auth
=head1 SYNOPSIS
<BASENAME::Login>
<BASENAME::Template name="login">
<input type="text" name="username"><br>
<input type="text" name="password">
</BASENAME::Template>
<BASENAME::Template name="username">
You are logged in as $:username
</BASENAME::Template>
<BASENAME::Template name="error">
Login Error: Try again.<br>
<input type="text" name="username"><br>
<input type="text" name="password">
</BASENAME::Template>
</BASENAME::Login>
=head1 DESCRIPTION
The Login Wyrd is used to provide an interface on any page for logging in as
a user of the site. It requires three templates: One for the login itself (called "login"), another to show that the user is logged in which can show information about which user is logged in (called 'username'), and a third for login errors (see SY...
=head2 HTML ATTRIBUTES
Wyrd/Site/Login.pm view on Meta::CPAN
$self->_data($self->_set(\%params, $self->error));
return;
}
#then check for a logged-in user. If the user is logged in, use the "username" template, which has spaces for the
#user's parameters. This prevents confusion caused by presenting a second login and allows the login area to display
#information about the user, i.e. "you are logged in as..."
my $username = $params{'username'} = $self->dbl->user->{'username'};
if ($username) {
#TODO: make the user attributes a configurable option set by the User object.
map {$params{$_} = $self->dbl->user->{$_}} qw(username password salutation firstname lastname organisation);
$self->_data($self->_set(\%params, $self->username));
return;
}
#Not logged in at all, set up a preauth login. Do this by setting the necessary parameters per A::W::Services::Auth
$params{'debug'} = $self->{'debug'} = $req->dir_config('Debug') || 0;
$params{'ticketfile'} = $self->{'ticketfile'} = $req->dir_config('KeyDBFile') || '/tmp/keyfile';
$params{'challenge_param'} = $self->{'challenge_param'} = $req->dir_config('ChallengeParam') || 'challenge';
$params{'key_url'} = $self->{'key_url'} = $req->dir_config('LSKeyURL') || die "Must define LSKeyURL";
$params{'preauth_url'} = $self->{'preauth_url'} = $req->dir_config('PreAuthURL') || die "Must define PreAuthURL";
Wyrd/User.pm view on Meta::CPAN
=head1 NAME
Apache::Wyrd::User - Abstract user object
=head1 SYNOPSIS
use BASENAME::User;
my $user = BASENAME::User->new(
{
username => 'fingers',
password => 'caged whale'
}
);
return AUTHORIZATION_REQUIRED unless (
$user->auth('elucidated bretheren of the ebon night')
);
=head1 DESCRIPTION
Provides an object for the storage of user and user-authorization information.
Wyrd/User.pm view on Meta::CPAN
} else {
$self->{$AUTOLOAD} = $newval;
return;
}
}
=pod
=item (Apache::Wyrd::User) C<new> (hashref)
Create a new User object, with, at minimum, B<username>, B<password>, B<auth>,
and B<auth_error> attributes.
=cut
sub new {
my ($class, $init) = @_;
if (ref($init) ne 'HASH') {
#probably not logged in. Use a blank.
$init = {};
}
$init->{'username'} ||= '';
$init->{'password'} ||= '';
$init->{'auth'} ||= {};
$init->{'auth_error'} ||= '';
bless $init, $class;
my $credential_name = $init->name_credentials;
$init->{$credential_name} = $init->make_credentials;
$init->get_authorization;
return $init;
}
=pod
Wyrd/User.pm view on Meta::CPAN
Read-only. Return the username of this user.
=cut
sub username {
my $self = shift;
return $self->{'username'};
}
=item (scalar) C<password> (void)
Read-only. Return the password of this user.
=cut
sub password {
my $self = shift;
return $self->{'password'};
}
=pod
=item (scalar) C<is> (scalar)
Return true if the username is equal to the given argument.
=cut
Wyrd/User.pm view on Meta::CPAN
my ($self, $username) = @_;
return 1 if ($self->{'username'} eq $username);
return;
}
#Credentials methods are for doing checksums on the user data to ensure the user is
#revived properly from storage.
sub make_credentials {
my ($self) = @_;
return sha1_hex($self->{'username'} . ':' . $self->{'password'});
}
sub check_credentials {
my ($self) = @_;
my $credential_name = $self->name_credentials;
my $value = $self->make_credentials;
return 1 if ($value eq $self->{$credential_name});
}
sub name_credentials {
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;
t/7_mysqlindex.t view on Meta::CPAN
}
}
if (!$count) {
warn <<'WARNING';
Could not initialize MySQL database. Will skip on this platform. To test,
make sure:
1. MySQL is installed and running
2. A user account for database test exists: test, and that it has no password
3. user account 'test' has sufficient privileges to create tables and insert
data.
4. dbd::mysql is installed and working
WARNING
}
print "1..$count\n";
exit 0 if (!$count);
t/lib/perl/TESTCLIENT/User.pm view on Meta::CPAN
#!/usr/bin/perl -w
package TESTCLIENT::User;
use strict;
use base qw(Apache::Wyrd::User);
use Apache::Wyrd::Services::SAK qw(token_parse);
1;
my %passwords = (
'testuser' => 'testing123'
);
my %auth_level = (
'testuser' => {
'test' => 1,
'admin' => 0
}
);
sub get_authorization {
my $self = shift;
unless ($passwords{$self->{username}} eq $self->{password}) {
$self->auth_error('Invalid Username or Password.');
return;
}
$self->{auth} = $auth_level{$self->{username}};
}
sub auth {
my ($self, $levels) = @_;
return 1 if ($self->{'auth'}->{'all'});
my @levels = token_parse($levels);
( run in 0.658 second using v1.01-cache-2.11-cpan-49f99fa48dc )