Mercurial > pub > Impl

changeset 97:964587c5183c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Added SecureCall to Web QueryHandlers stack many bug fixes to Security and Web Application modules
author wizard
date Tue, 04 May 2010 04:04:37 +0400
parents 4c55aed00ff2
children 00d88c5e8203
files Lib/IMPL/Exception.pm Lib/IMPL/Security/Context.pm Lib/IMPL/Security/Principal.pm Lib/IMPL/Test/Unit.pm Lib/IMPL/Web/Application.pm Lib/IMPL/Web/Application/Response.pm Lib/IMPL/Web/QueryHandler/PageFormat.pm Lib/IMPL/Web/QueryHandler/SecureCall.pm Lib/IMPL/Web/QueryHandler/SecureCookie.pm Lib/IMPL/Web/Security.pm Lib/IMPL/Web/TT/Document.pm _test/Resources/app.xml _test/temp.pl
diffstat 13 files changed, 145 insertions(+), 58 deletions(-) [+]
line wrap: on
line diff
--- 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;
--- 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;
     }
--- 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;
--- 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 {
--- 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<CGI> объект следующего запроса, если
+запросов больше нет, то возвращает C<undef>. По-умолчанию использует C<defaultFetchRequest>.
+
+Может быть как ссылкой на функцию, так и объектом типа C<IMPL::Web::Application::RequestFetcher>.
+
 =item C< [get,set,list] handlersQuery >
 
 Список обработчиков запросов, которые будут переданы созданному объекту-действию.
--- 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};	
--- 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;
--- /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
--- 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;
--- 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) ) {
--- 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;
 }
--- 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 @@
 	<!-- Set default output encoding, can be changed due query handling -->
 	<responseCharset>utf-8</responseCharset>
 	
-	<!-- Actions creation configuration -->
-	<actionFactory type="IMPL::Object::Factory">
-		<factory>IMPL::Web::Application::Action</factory>
-		<parameters type='HASH'>
-			<responseFactory type='IMPL::Object::Factory'>
-				<factory>IMPL::Web::Application::Response</factory>
-				<parameters type='HASH'>
-					<streamOut>memory</streamOut>
-				</parameters>
-			</responseFactory>
-		</parameters>
-	</actionFactory>
-	
 	<!-- Query processing  -->
 	<handlersQuery type="IMPL::Object::List">
 		<item type="IMPL::Web::QueryHandler::PageFormat">
--- 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