Apache-SWIT-Security

 view release on metacpan or  search on metacpan

lib/Apache/SWIT/Security/Maker.pm  view on Meta::CPAN

use strict;
use warnings FATAL => 'all';

package Apache::SWIT::Security::Maker::MF;
use base 'Apache::SWIT::Subsystem::Makefile';

sub make_this_subsystem_dumps {
	my %ot = shift()->SUPER::make_this_subsystem_dumps(@_);
	delete $ot{original_tree}->{dumped_tests}->{"020_secparams.t"};
	return %ot;
}

package Apache::SWIT::Security::Maker;
use base 'Apache::SWIT::Subsystem::Maker';
use Apache::SWIT::Security::Role::Loader;
use Data::Dumper;
use YAML;
use Apache::SWIT::Maker::Config;

lib/Apache/SWIT/Security/Maker.pm  view on Meta::CPAN

	$self->write_loader_dump_pm($loader->url_manager, 'Manager', '');

	my $uc = $tree->{env_vars}->{AS_SECURITY_USER_CLASS};
	my $s = "use $uc;\n$uc->swit_startup;\n";
	write_file("blib/conf/do_swit_startups.pl"
		, $s . read_file("blib/conf/do_swit_startups.pl"));
}

sub install_subsystem {
	my ($self, $module) = @_;
	$self->SUPER::install_subsystem($module);

	my $tree = Apache::SWIT::Maker::Config->instance;
	my $full_class = Apache::SWIT::Maker::Config->instance->root_class
				. '::' . $module;
	my $ot = $self->this_subsystem_original_tree;
	$tree->{roles} = $ot->{roles};
	$tree->{env_vars}->{ "AS_SECURITY_" . uc($_) }
		= $full_class . "::Role::" . $_ for qw(Container Manager);
	$tree->{env_vars}->{AS_SECURITY_USER_CLASS}
		= 'Apache::SWIT::Security::DB::User';

lib/Apache/SWIT/Security/Session.pm  view on Meta::CPAN

}

sub is_allowed {
	my ($self, $rel_uri) = @_;
	my $uri = URI->new_abs($rel_uri, $self->request->uri);
	return $self->_is_allowed($uri->path, %{ $uri->query_form_hash });
}

sub access_handler($$) {
	my ($class, $r) =  @_;
	my $res = $class->SUPER::access_handler($r);
	my $apr = Apache2::Request->new($r);
	return $r->pnotes('SWITSession')->_is_allowed($r->uri
		, %{ $apr->param || {} }) ? $res : Apache2::Const::FORBIDDEN();
}

1;

lib/Apache/SWIT/Security/UI/UserProfile.pm  view on Meta::CPAN

sub ht_swit_render {
	my ($class, $r, $root) = @_;
	$root->cdbi_load;
	return $root;
}

sub ht_swit_update_die {
	my ($class, $err, $r, $tested) = @_;
	my $em = ($err =~ /WRONG/) ? [ old_password => 'wrong' ] : undef;
	$class->SUPER::ht_swit_update_die(@_) unless $em;
	return $class->swit_encode_errors([ $em ]);
}

sub ht_swit_update {
	my ($class, $r, $root) = @_;
	my $u = $root->cdbi_retrieve;
	die "WRONG" if $u->password ne Hash($root->old_password);
	$u->password(Hash($root->new_password));
	$root->cdbi_update;
	return $root->ht_make_query_string("r", "user_id");

t/950_install.t  view on Meta::CPAN

$mt->install_session_base;

swmani_write_file('lib/MU/Us.pm', conv_module_contents("MU::Us", <<ENDS));
use base 'Apache::SWIT::Security::DB::User';
use File::Slurp;

append_file('$rdir/us.txt', "used\\n");

sub role_ids {
	append_file('$rdir/us.txt', "role_ids\\n");
	return shift()->SUPER::role_ids(\@_);
}
ENDS

swmani_write_file('lib/MU/Lo.pm', conv_module_contents("MU::Lo", <<ENDS));
use base 'Apache::SWIT::Security::UI::Login';
use File::Slurp;

append_file('$rdir/us.txt', "mu_login\\n");

package MU::Lo::Root;
use base 'HTML::Tested';
ENDS

append_file('lib/MU/Session.pm', <<ENDS);
use File::Slurp;
sub authorize {
	append_file('$rdir/us.txt', "authorize\\n");
	return shift()->SUPER::authorize(\@_);
}
ENDS

my $tree = YAML::LoadFile('conf/swit.yaml');
$tree->{env_vars}->{AS_SECURITY_USER_CLASS} = 'MU::Us';
$tree->{pages}->{"thesub/login"}->{class} = 'MU::Lo';
$tree->{capabilities} = { a_cap => [ '+admin' ], b_cap => [ '-all' ] };

my $ts = $tree->{startup_classes};
is_deeply($ts, [ 'Apache::SWIT::Security::Session' ]) or ASTU_Wait(Dumper($ts));