# HG changeset patch # User cin # Date 1334583774 -14400 # Node ID a705e848dcc7878de3d5684726e1dc07229913db # Parent 7a920771fd8ef2b08c7b903f4ae3ffec3595f070 added IMPL::Config::Reference diff -r 7a920771fd8e -r a705e848dcc7 Lib/IMPL/Config/Class.pm --- a/Lib/IMPL/Config/Class.pm Wed Apr 11 17:50:33 2012 +0400 +++ b/Lib/IMPL/Config/Class.pm Mon Apr 16 17:42:54 2012 +0400 @@ -5,8 +5,11 @@ use parent qw(IMPL::Config); use IMPL::Exception; use IMPL::Class::Property; +use Carp qw(carp); BEGIN { + carp "the module is deprecated"; + public property Type => prop_all; public property Parameters => prop_all; public property IsSingleton => prop_all; diff -r 7a920771fd8e -r a705e848dcc7 Lib/IMPL/Config/Container.pm --- a/Lib/IMPL/Config/Container.pm Wed Apr 11 17:50:33 2012 +0400 +++ b/Lib/IMPL/Config/Container.pm Mon Apr 16 17:42:54 2012 +0400 @@ -4,8 +4,11 @@ use parent qw(IMPL::Config); use IMPL::Class::Property; +use Carp qw(carp); BEGIN { + carp "the module is deprecated"; + public property Chidren => prop_all; } diff -r 7a920771fd8e -r a705e848dcc7 Lib/IMPL/Config/Reference.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Lib/IMPL/Config/Reference.pm Mon Apr 16 17:42:54 2012 +0400 @@ -0,0 +1,97 @@ +package IMPL::Config::Reference; +use strict; + +use IMPL::Exception; + +__PACKAGE__->PassThroughArgs; + +sub restore { + my ($self,$data,$surrogate) = @_; + + my @path; + + my ($tagTarget,$target) = splice @$data, 0, 2; + + die new IMPL::Exception('A traget tag must be the first tag in the reference specification') unless $tagTarget eq 'target'; + + while(my ($method,$args) = splice @$data, 0, 2 ) { + $target = $self->_Invoke({ method => $method, args => $args}); + } + return $target; +} + +sub _InvokeMember { + my ($self,$object,$member) = @_; + + my $method = $member->{method}; + + local $@; + return eval { + ref $object eq 'HASH' ? + $object->{$method} + : + $object->$method( + exists $member->{args} ? + _as_list($member->{args}) + : + () + ) + }; +} + +sub _as_list { + ref $_[0] ? + (ref $_[0] eq 'HASH' ? + %{$_[0]} + : + (ref $_[0] eq 'ARRAY'? + @{$_[0]} + : + $_[0] + ) + ) + : + ($_[0]); +} + +1; + +__END__ + +=pod + +=head1 NAME + +C - ссылка на внешний объект, вычисляемый на этапе десериализации данных. + +=head1 SYNOPSIS + +=begin code xml + + + + IMPL::Config + stdprocessing.xml + + + +=end code xml + +=head1 DESCRIPTION + +Позволяет на указвать ссылки на вычисляемые объекты, например, загружаемые из файлов. Ссылки такого рода +будут вычислены на этапе десериализации еще до того, как будет создан объект верхнего уровня, поэтому +следует избегать таких ссылок на сам (его свойства и методы) десериализуемый объект. + +=head1 MEMBERS + +=head2 C + +Использует данные переданные в параметре дата C<$data> для вычисления свойства. Данный метод - стандартный +метод для десериализации объекта, а параметр C<$data> содержит пары значений C<(имя_узла,значение_узла)>, +первая пара обязательно является узлом C, а его значение - целевой объект, который будет +использован для вычисления конечного значения. + +=back + +=cut \ No newline at end of file diff -r 7a920771fd8e -r a705e848dcc7 Lib/IMPL/Serialization.pm --- a/Lib/IMPL/Serialization.pm Wed Apr 11 17:50:33 2012 +0400 +++ b/Lib/IMPL/Serialization.pm Mon Apr 16 17:42:54 2012 +0400 @@ -1,12 +1,6 @@ package IMPL::Serialization; use strict; -# 20060222 -# пїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ -# (пїЅ) Sourcer, cin.sourcer@gmail.com -# revision 3 (20090517) - - package IMPL::Serialization::Context; use parent qw(IMPL::Object); @@ -16,31 +10,24 @@ use Scalar::Util qw(refaddr); BEGIN { - private _direct property ObjectWriter => prop_all; # пїЅпїЅпїЅпїЅпїЅпїЅ, пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ пїЅ пїЅпїЅпїЅпїЅпїЅ - private _direct property Context => prop_all; # пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ (пїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ, пїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ) - private _direct property NextID => prop_all;# пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅ + private _direct property ObjectWriter => prop_all; + private _direct property Context => prop_all; + private _direct property NextID => prop_all; - # пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ, пїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅ, пїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅ. пїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ - # пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅ IMPL::Serialization::Context, пїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ public _direct property Serializer => prop_all; - private _direct property State => prop_all; # пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ + private _direct property State => prop_all; } -# пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ, пїЅ.пїЅ. пїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅ пїЅпїЅпїЅпїЅпїЅ sub STATE_CLOSED () { 0 } -# пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ, пїЅ.пїЅ. пїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅ, пїЅпїЅ пїЅ пїЅпїЅпїЅ пїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅ пїЅпїЅпїЅпїЅпїЅ sub STATE_OPENED () { 1 } -# пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ пїЅ пїЅ пїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ sub STATE_COMPLEX () { 2 } -# пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ пїЅ пїЅ пїЅпїЅпїЅпїЅ пїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅ пїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ, пїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ sub STATE_DATA () { 3 } sub CTOR { my ($this,%args) = @_; $this->{$ObjectWriter} = $args{'ObjectWriter'}; - #$this->{$Context} = {}; $this->{$NextID} = 1; $this->{$Serializer} = ($args{'Serializer'} ? $args{'Serializer'} : \&DefaultSerializer ); $this->{$State} = STATE_CLOSED; @@ -54,11 +41,9 @@ die new Exception ('Invalid operation') if $this->{$State} == STATE_DATA; if (not ref $Var) { - # пїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅ, пїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅ, пїЅпїЅ пїЅпїЅпїЅ пїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅ, пїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅ, пїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅ - # пїЅпїЅ пїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ, пїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ, пїЅпїЅ пїЅпїЅ пїЅпїЅ пїЅпїЅпїЅпїЅпїЅ my $prevState = $this->{$State}; - $this->{$ObjectWriter}->BeginObject(name => $sName);#, type => 'SCALAR'); + $this->{$ObjectWriter}->BeginObject(name => $sName); $this->{$State} = STATE_OPENED; $this->{$Serializer}->($this,\$Var); @@ -148,10 +133,9 @@ use IMPL::Exception; BEGIN { - # пїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅ, пїЅпїЅпїЅ, пїЅпїЅпїЅпїЅ - пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ, пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ - пїЅпїЅпїЅпїЅпїЅпїЅ. private _direct property Context => prop_all; - # пїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ. пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ + # структура информации об объекте # { # Type => 'typename', # Name => 'object_name', @@ -160,10 +144,8 @@ # } private _direct property CurrentObject => prop_all; - # пїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ. пїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅ пїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ. private _direct property ObjectsPath => prop_all; - # пїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ public _direct property Root => prop_get; # пїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ пїЅ пїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅпїЅ пїЅпїЅ пїЅпїЅпїЅпїЅ пїЅпїЅпїЅпїЅпїЅпїЅ diff -r 7a920771fd8e -r a705e848dcc7 Lib/IMPL/Web/Application/RestResource.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Lib/IMPL/Web/Application/RestResource.pm Mon Apr 16 17:42:54 2012 +0400 @@ -0,0 +1,16 @@ +package IMPL::Web::Application::RestResource; +use strict; + +1; + +__END__ + +=pod + +=head1 NAME + +C - ресурс Rest вебсервиса. + +=head1 DESCRIPTION + +=cut \ No newline at end of file diff -r 7a920771fd8e -r a705e848dcc7 Lib/IMPL/Web/Handler/SecureCookie.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Lib/IMPL/Web/Handler/SecureCookie.pm Mon Apr 16 17:42:54 2012 +0400 @@ -0,0 +1,115 @@ +package IMPL::Web::QueryHandler::SecureCookie; +use strict; + +use parent qw(IMPL::Web::QueryHandler); +use Digest::MD5 qw(md5_hex); + +use IMPL::Class::Property; +use IMPL::Security::Auth qw(:Const); +use IMPL::Security; + +BEGIN { + public property salt => prop_all; +} + +sub CTOR { + my ($this) = @_; + + $this->salt('DeadBeef') unless $this->salt; +} + +sub Process { + my ($this,$action,$nextHandler) = @_; + + return undef unless $nextHandler; + + local $IMPL::Security::authority = $this; + + my $method = $action->query->cookie('method') || 'simple'; + + if ($method eq 'simple') { + + my $sid = $action->query->cookie('sid'); + my $cookie = $action->query->cookie('sdata'); + my $sign = $action->query->cookie('sign'); + + if ( + $sid and + $cookie and + $sign and + $sign eq md5_hex( + $this->salt, + $sid, + $cookie, + $this->salt + ) + ) { + # TODO: add a DefferedProxy to deffer a request to a data source + my $context = $action->application->security->sourceSession->find( + { id => $sid } + ) or return $nextHandler->(); + + my ($result,$challenge) = $context->auth->ValidateSession($cookie); + + if ($result == AUTH_SUCCESS) { + $context->authority($this); + return $context->Impersonate($nextHandler); + } else { + return $nextHandler->(); + } + } else { + return $nextHandler->(); + } + } else { + return $nextHandler->(); + } +} + +sub WriteResponse { + my ($this,$response,$sid,$cookie,$method) = @_; + + my $sign = md5_hex( + $this->salt, + $sid, + $cookie, + $this->salt + ); + + $response->setCookie(sid => $sid); + $response->setCookie(sdata => $cookie); + $response->setCookie(sign => $sign); + $response->setCookie(method => $method) if $method; +} + +1; + +__END__ + +=pod + +=head1 NAME + +C + +=head1 DESCRIPTION + +C + +Возобновляет сессию пользователя на основе информации переданной через Cookie. + +Использует механизм подписи информации для проверки верности входных данных перед +началом каких-либо действий. + +Данный обработчик возвращает результат выполнения следдующего обработчика. + +=head1 MEMBERS + +=over + +=item C<[get,set] salt> + +Скаляр, использующийся для подписи данных. + +=back + +=cut diff -r 7a920771fd8e -r a705e848dcc7 Lib/IMPL/Web/View/TTLoader.pm --- a/Lib/IMPL/Web/View/TTLoader.pm Wed Apr 11 17:50:33 2012 +0400 +++ b/Lib/IMPL/Web/View/TTLoader.pm Mon Apr 16 17:42:54 2012 +0400 @@ -11,6 +11,7 @@ use parent qw( IMPL::Object + IMPL::Object::Serializable ); BEGIN { @@ -26,6 +27,26 @@ private property _globals => PROP_ALL; } +sub save { + my ($this,$context) = @_; + + $context->AddVar($_, $this->$_()) for qw(options provider context ext layoutBase); +} + +sub restore { + my ($class,$data,$surrogate) = @_; + + my %params = @$data; + + my $refOpts = delete $params{options}; + + if ($surrogate){ + $surrogate->callCTOR($refOpts,%params); + } else { + $surrogate = $class->new($refOpts,%params); + } +} + sub CTOR { my ($this,$refOpts,%args) = @_;