# HG changeset patch # User wizard # Date 1272931477 -14400 # Node ID 964587c5183ca7ff0af3684074f42b758393f488 # Parent 4c55aed00ff21864ee169176e5c781b294e0822a Added SecureCall to Web QueryHandlers stack many bug fixes to Security and Web Application modules diff -r 4c55aed00ff2 -r 964587c5183c Lib/IMPL/Exception.pm --- a/Lib/IMPL/Exception.pm Fri Apr 30 15:03:38 2010 +0400 +++ b/Lib/IMPL/Exception.pm Tue May 04 04:04:37 2010 +0400 @@ -104,6 +104,10 @@ our @ISA = qw(IMPL::Exception); __PACKAGE__->PassThroughArgs; +package IMPL::AccessDeniedException; +our @ISA = qw(IMPL::SecurityException); +our %CTOR = ( 'IMPL::SecurityException' => sub { 'Access denied' ,@_ } ); + package Exception; our @ISA = qw(IMPL::Exception); __PACKAGE__->PassThroughArgs; diff -r 4c55aed00ff2 -r 964587c5183c Lib/IMPL/Security/Context.pm --- a/Lib/IMPL/Security/Context.pm Fri Apr 30 15:03:38 2010 +0400 +++ b/Lib/IMPL/Security/Context.pm Tue May 04 04:04:37 2010 +0400 @@ -30,14 +30,20 @@ my ($this,$code) = @_; my $old = $current; + $current = $this; my $result; - local $@; - eval { - $result = $code->(); - }; + my $e; + + { + local $@; + eval { + $result = $code->(); + }; + $e = $@; + } $current = $old; - if($@) { - die $@; + if($e) { + die $e; } else { return $result; } diff -r 4c55aed00ff2 -r 964587c5183c Lib/IMPL/Security/Principal.pm --- a/Lib/IMPL/Security/Principal.pm Fri Apr 30 15:03:38 2010 +0400 +++ b/Lib/IMPL/Security/Principal.pm Tue May 04 04:04:37 2010 +0400 @@ -5,6 +5,8 @@ use base qw(IMPL::Object IMPL::Object::Autofill); use IMPL::Class::Property; +__PACKAGE__->PassThroughArgs; + BEGIN { public property name => prop_get; public property description => prop_all; diff -r 4c55aed00ff2 -r 964587c5183c Lib/IMPL/Test/Unit.pm --- a/Lib/IMPL/Test/Unit.pm Fri Apr 30 15:03:38 2010 +0400 +++ b/Lib/IMPL/Test/Unit.pm Tue May 04 04:04:37 2010 +0400 @@ -39,7 +39,7 @@ sub Cleanup { my ($this,$session) = @_; - $session->{$_} = $this->$_() foreach map $_->DataList, $this->get_meta('IMPL::Test::Unit::SharedData'); + $session->{$_} = $this->$_() foreach map $_->DataList, $this->get_meta('IMPL::Test::Unit::SharedData',undef,1); 1; } @@ -53,7 +53,7 @@ sub InitTest { my ($this,$session) = @_; - $this->$_($session->{$_}) foreach map $_->DataList, $this->get_meta('IMPL::Test::Unit::SharedData'); + $this->$_($session->{$_}) foreach map $_->DataList, $this->get_meta('IMPL::Test::Unit::SharedData',undef,1); } sub FinishUnit { diff -r 4c55aed00ff2 -r 964587c5183c Lib/IMPL/Web/Application.pm --- a/Lib/IMPL/Web/Application.pm Fri Apr 30 15:03:38 2010 +0400 +++ b/Lib/IMPL/Web/Application.pm Tue May 04 04:04:37 2010 +0400 @@ -19,6 +19,7 @@ public property responseCharset => prop_all; public property security => prop_all; public property options => prop_all; + public property fetchRequestMethod => prop_all; } sub CTOR { @@ -26,6 +27,8 @@ $this->actionFactory('IMPL::Web::Application::Action') unless $this->actionFactory; $this->responseCharset('utf-8') unless $this->responseCharset; + $this->fetchRequestMethod(\&defaultFetchRequest) unless $this->fetchRequestMethod; + $this->handlerError(\&defaultHandlerError) unless $this->handlerError; } sub Run { @@ -38,26 +41,55 @@ application => $this, ); - $action->response->charset($this->responseCharset); - - $action->ChainHandler($_) foreach $this->handlersQuery; - - $action->Invoke(); - - $action->response->Complete; + eval { + $action->response->charset($this->responseCharset); + + $action->ChainHandler($_) foreach $this->handlersQuery; + + $action->Invoke(); + + $action->response->Complete; + }; + if ($@) { + my $e = $@; + eval { $this->handlerError()->($this,$action,$e); 1;} or warn "Error in handlerError: ",$@; + } } } +sub FetchRequest { + my ($this) = @_; + + if( ref $this->fetchRequestMethod eq 'CODE' ) { + return $this->fetchRequestMethod->($this); + } else { + die new IMPL::Exception("Unknown fetchRequestMethod type",ref $this->fetchRequestMethod); + } +} + { my $hasFetched = 0; - sub FetchRequest { + sub defaultFetchRequest { return undef if $hasFetched; $hasFetched = 1; return CGI->new(); } } +sub defaultHandlerError { + my ($this,$action,$e) = @_; + warn $e; + if ( eval { $action->ReinitResponse(); 1; } ) { + $action->response->contentType('text/plain'); + $action->response->charset($this->responseCharset); + $action->response->status(500); + my $hout = $action->response->streamBody; + print $hout $e; + $action->response->Complete(); + } +} + 1; __END__ @@ -199,6 +231,13 @@ =end code +=item C< [get,set] fetchRequestMethod > + +Метод получения CGI запроса. Возвращает C объект следующего запроса, если +запросов больше нет, то возвращает C. По-умолчанию использует C. + +Может быть как ссылкой на функцию, так и объектом типа C. + =item C< [get,set,list] handlersQuery > Список обработчиков запросов, которые будут переданы созданному объекту-действию. diff -r 4c55aed00ff2 -r 964587c5183c Lib/IMPL/Web/Application/Response.pm --- a/Lib/IMPL/Web/Application/Response.pm Fri Apr 30 15:03:38 2010 +0400 +++ b/Lib/IMPL/Web/Application/Response.pm Tue May 04 04:04:37 2010 +0400 @@ -102,7 +102,7 @@ $opt{-expires} = $this->expires if $this->expires; my $refCookies = $this->cookies; - $opt{-cookie} = [map CGI::Cookie->new(-name => $_, $refCookies->{$_} ), keys %$refCookies] if $refCookies; + $opt{-cookie} = [map _createCookie($_,$refCookies->{$_}), keys %$refCookies] if $refCookies; my $hOut = $this->streamOut; @@ -112,6 +112,10 @@ } } +sub _createCookie { + return UNIVERSAL::isa($_[1], 'CGI::Cookie') ? $_[1] : CGI::Cookie->new(-name => $_[0], -value => $_[1] ); +} + sub setCookie { my ($this,$name,$value) = @_; @@ -157,8 +161,8 @@ my $hOut = $this->streamOut; $this->_PrintHeader(); - - $this->_streamBody(undef); + + close $this->_streamBody(); if ($this->buffered) { print $hOut ${$this->_bufferBody}; diff -r 4c55aed00ff2 -r 964587c5183c Lib/IMPL/Web/QueryHandler/PageFormat.pm --- a/Lib/IMPL/Web/QueryHandler/PageFormat.pm Fri Apr 30 15:03:38 2010 +0400 +++ b/Lib/IMPL/Web/QueryHandler/PageFormat.pm Tue May 04 04:04:37 2010 +0400 @@ -5,19 +5,20 @@ use IMPL::Class::Property; use IMPL::Web::TT::Document; +use IMPL::Security::Context; use File::Spec; use Error qw(:try); BEGIN { public property templatesCharset => prop_all; public property templatesBase => prop_all; + public property defaultTarget => prop_all; } sub CTOR { my ($this) = @_; $this->templatesCharset('utf-8') unless $this->templatesCharset; - $this->templatesBase('.') unless $this->templatesBase; } sub Process { @@ -26,13 +27,25 @@ my $doc = new IMPL::Web::TT::Document(); try { - my @path = split /\//, $ENV{PATH_TRANSLATED}; + + $this->templatesBase($ENV{DOCUMENT_ROOT}) unless $this->templatesBase; + + my $pathInfo = $ENV{PATH_INFO}; + local $ENV{PATH_INFO} = $pathInfo || $this->defaultTarget; + + my @path = split /\//, ($ENV{PATH_INFO} || '') or die new IMPL::Exception("PATH_INFO is empty and no defaultTarget specified" ); $doc->LoadFile ( File::Spec->catfile($this->templatesBase,@path), $this->templatesCharset ); + $doc->AddVar( result => $nextHandler->() ); + { + local $@; + $doc->AddVar( user => eval { IMPL::Security::Context->current->principal; } ); + $doc->AddVar( session => eval { IMPL::Security::Context->current; } ); + warn $@ if $@; + } $action->response->contentType('text/html'); my $hOut = $action->response->streamBody; - print $hOut $doc->Render(); } finally { $doc->Dispose; diff -r 4c55aed00ff2 -r 964587c5183c Lib/IMPL/Web/QueryHandler/SecureCall.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Lib/IMPL/Web/QueryHandler/SecureCall.pm Tue May 04 04:04:37 2010 +0400 @@ -0,0 +1,37 @@ +package IMPL::Web::QueryHandler::SecureCall; +use strict; +use base qw(IMPL::Web::QueryHandler); + +use IMPL::Class::Property; +use IMPL::Exception; +use Carp; + +BEGIN { + public property namespace => prop_all; +} + +__PACKAGE__->PassThroughArgs; + +sub Process { + my ($this,$action,$nextHandler) = @_; + + my $namespace = $this->namespace || $action->application->type; + + my @target = grep $_, split /\//, ($ENV{PATH_INFO} || '') or die new IMPL::Exception("No target specified"); + + my $method = pop @target; + $method =~ s/\.\w+$//; + + my $module = join '::',$namespace,@target; + + eval "require $module; 1;"; + carp $@ if $@; + + if(UNIVERSAL::can($module,'InvokeAction')) { + $module->InvokeAction($method,$action); + } else { + die new IMPL::InvalidOperationException("Failed to invoke action",$ENV{PATH_INFO},$module,$method); + } +} + +1; \ No newline at end of file diff -r 4c55aed00ff2 -r 964587c5183c Lib/IMPL/Web/QueryHandler/SecureCookie.pm --- a/Lib/IMPL/Web/QueryHandler/SecureCookie.pm Fri Apr 30 15:03:38 2010 +0400 +++ b/Lib/IMPL/Web/QueryHandler/SecureCookie.pm Tue May 04 04:04:37 2010 +0400 @@ -23,6 +23,8 @@ return undef unless $nextHandler; + local $IMPL::Security::authority = $this; + my $method = $action->query->cookie('method') || 'simple'; if ($method eq 'simple') { @@ -42,8 +44,6 @@ $this->salt ) ) { - local $IMPL::Security::authority = $this; - my $context = $action->application->security->sourceSession->find( { id => $sid } ) or return $nextHandler->(); @@ -56,9 +56,11 @@ } else { return $nextHandler->(); } + } else { + return $nextHandler->(); } } else { - die new IMPL::Exception("Unknown auth method",$method); + return $nextHandler->(); } } @@ -72,10 +74,10 @@ $this->salt ); - $this->setCookie(sid => $sid); - $this->setCookie(sdata => $cookie); - $this->setCookie(sign => $sign); - $this->setCookie(method => $method) if $method; + $response->setCookie(sid => $sid); + $response->setCookie(sdata => $cookie); + $response->setCookie(sign => $sign); + $response->setCookie(method => $method) if $method; } 1; diff -r 4c55aed00ff2 -r 964587c5183c Lib/IMPL/Web/Security.pm --- a/Lib/IMPL/Web/Security.pm Fri Apr 30 15:03:38 2010 +0400 +++ b/Lib/IMPL/Web/Security.pm Tue May 04 04:04:37 2010 +0400 @@ -17,7 +17,7 @@ sub AuthUser { my ($this,$name,$package,$challenge) = @_; - my $user = $this->sourceUser->find({name => $name}); + my $user = $this->sourceUser->find({name => $name}) or return { status => AUTH_FAIL, answer => "Can't find a user '$name'" }; my $auth; if ( my $secData = $user->secData($package) ) { diff -r 4c55aed00ff2 -r 964587c5183c Lib/IMPL/Web/TT/Document.pm --- a/Lib/IMPL/Web/TT/Document.pm Fri Apr 30 15:03:38 2010 +0400 +++ b/Lib/IMPL/Web/TT/Document.pm Tue May 04 04:04:37 2010 +0400 @@ -86,6 +86,12 @@ $this->template($this->context->template($fileName)); } +sub AddVar { + my ($this,$name,$value) = @_; + + $this->context->stash->set($name,$value); +} + sub title { $_[0]->template->title; } diff -r 4c55aed00ff2 -r 964587c5183c _test/Resources/app.xml --- a/_test/Resources/app.xml Fri Apr 30 15:03:38 2010 +0400 +++ b/_test/Resources/app.xml Tue May 04 04:04:37 2010 +0400 @@ -26,19 +26,6 @@ utf-8 - - - IMPL::Web::Application::Action - - - IMPL::Web::Application::Response - - memory - - - - - diff -r 4c55aed00ff2 -r 964587c5183c _test/temp.pl --- a/_test/temp.pl Fri Apr 30 15:03:38 2010 +0400 +++ b/_test/temp.pl Tue May 04 04:04:37 2010 +0400 @@ -1,19 +1,6 @@ #!/usr/bin/perl use strict; -package Boz; - -sub run { - my ($self,$code) = @_; - - $code->('Boz'); -} +use IMPL::Security::Context; -sub speak { - my ($self,$str) = @_; - print "Boz: $str"; -} - -sub type { $_[0]; } - -print type Boz; \ No newline at end of file +print IMPL::Security::Context->current->principal->name; \ No newline at end of file