oqapi/webgui
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge remote branch 'upstream/WebGUI8' into 8-merge

Browse source 
Conflicts:
	docs/gotcha.txt
	docs/previousVersion.sql
	lib/WebGUI/Asset/Wobject/GalleryAlbum.pm
	lib/WebGUI/Asset/Wobject/Navigation.pm
	lib/WebGUI/AssetLineage.pm
	lib/WebGUI/Config.pm
	lib/WebGUI/Form/Template.pm
	lib/WebGUI/Group.pm
	lib/WebGUI/VersionTag.pm
	lib/WebGUI/Workflow/Activity/TrashExpiredEvents.pm
	t/AdSpace.t
	t/Asset/AssetExportHtml.t
	t/Asset/AssetLineage.t
	t/Asset/Story.t
	t/Asset/Template/HTMLTemplateExpr.t
	t/Asset/Wobject/Gallery/00base.t
	t/Asset/Wobject/GalleryAlbum/00base.t
	t/Asset/Wobject/GalleryAlbum/ajax.t
	t/Asset/Wobject/InOutBoard.t
	t/Asset/Wobject/StoryArchive.t
	t/Asset/Wobject/Survey/ExpressionEngine.t
	t/Asset/Wobject/Survey/Reports.t
	t/AssetAspect/RssFeed.t
	t/Auth/mech.t
	t/Group.t
	t/Mail/Send.t
	t/Operation/AdSpace.t
	t/Session/ErrorHandler.t
	t/Session/Scratch.t
	t/Session/Url.t
	t/Shop/Cart.t
	t/Shop/Pay.t
	t/Shop/Ship.t
	t/Shop/ShipDriver.t
	t/Shop/TaxDriver/Generic.t
	t/Shop/Vendor.t
	t/VersionTag.t
	t/lib/WebGUI/Test.pm
This commit is contained in:
Doug Bell 2010-07-14 18:20:00 -05:00
commit 708b47d73c
165 changed files with 3199 additions and 5718 deletions
Download patch file Download diff file Expand all files Collapse all files

193
lib/WebGUI/Session/Env.pm
View file

@ -1,193 +0,0 @@
package WebGUI::Session::Env;
=head1 LEGAL
-------------------------------------------------------------------
WebGUI is Copyright 2001-2009 Plain Black Corporation.
-------------------------------------------------------------------
Please read the legal notices (docs/legal.txt) and the license
(docs/license.txt) that came with this distribution before using
this software.
-------------------------------------------------------------------
http://www.plainblack.com info@plainblack.com
-------------------------------------------------------------------
=cut
use strict;
=head1 NAME
Package WebGUI::Session::Env
=head1 DESCRIPTION
This package allows you to reference environment variables.
=head1 SYNOPSIS
$env = WebGUI::Session::Env->new;
$value = $env->get('REMOTE_ADDR');
return 'not gonna see it' if $env->requestNotViewed() ;
=head1 METHODS
These methods are available from this package:
=cut
#-------------------------------------------------------------------
=head2 callerIsSearchSite ( )
Returns true if the remote address matches a site which is a known indexer or spider.
=cut
sub callerIsSearchSite {
my $self = shift;
my $remoteAddress = $self->getIp;
return 1 if $remoteAddress =~ /203\.87\.123\.1../ # Blaiz Enterprise Rawgrunt search
|| $remoteAddress =~ /123\.113\.184\.2../ # Unknown Yahoo Robot
|| $remoteAddress == '';
return 0;
}
#-------------------------------------------------------------------
=head2 clientIsSpider ( )
Returns true is the client/agent is a spider/indexer or some other non-human interface, determined
by checking the user agent against a list of known spiders.
=cut
sub clientIsSpider {
my $self = shift;
my $userAgent = $self->get('HTTP_USER_AGENT');
return 1 if $userAgent eq ''
|| $userAgent =~ m<(^wre\/| # the WRE wget's http://localhost/ every 2-3 minutes 24 hours a day...
^morpheus|
libwww|
s[pb]ider|
bot|
robo|
sco[ou]t|
crawl|
miner|
reaper|
finder|
search|
engine|
download|
fetch|
scan|
slurp)>ix;
return 0;
}
#-------------------------------------------------------------------
=head2 get( varName )
Retrieves the current value of an environment variable.
=head3 varName
The name of the variable.
=cut
sub get {
my $self = shift;
my $var = shift;
return $$self->{$var};
}
#-------------------------------------------------------------------
=head2 getIp ( )
Returns the user's IP address.
=cut
sub getIp {
my $self = shift;
return $self->get('REMOTE_ADDR');
}
#-------------------------------------------------------------------
=head2 new ( )
Constructor. Returns an env object.
=cut
sub new {
my $class = shift;
my $session = shift;
my $env;
if ($session->request) {
$env = $session->request->env;
}
else {
$env = {};
}
return bless \$env, $class;
}
#-------------------------------------------------------------------
=head2 requestNotViewed ( )
Returns true is the client/agent is a spider/indexer or some other non-human interface
=cut
sub requestNotViewed {
my $self = shift;
return $self->clientIsSpider();
# || $self->callerIsSearchSite(); # this part is currently left out because
# it has minimal effect and does not manage
# IPv6 addresses. it may be useful in the
# future though
}
#-------------------------------------------------------------------
=head2 sslRequest ( )
Returns true if a https request was made.
HTTP_SSLPROXY is set by mod_proxy in the WRE so that WebGUI knows that the original request
was made via SSL.
=cut
sub sslRequest {
my $self = shift;
return $self->get('psgi.url_scheme') eq 'https';
}
1;

2
lib/WebGUI/Session/ErrorHandler.pm
View file

@ -253,7 +253,7 @@ sub security {
my $self = shift;
my $message = shift;
@_ = ($self, $self->session->user->username." (".$self->session->user->userId.") connecting from "
.$self->session->env->getIp." attempted to ".$message);
.$self->session->request->address." attempted to ".$message);
goto $self->can('warn');
}

84
lib/WebGUI/Session/Request.pm
View file

@ -17,6 +17,68 @@ is created.
=head1 METHODS
=cut
#-------------------------------------------------------------------
=head2 clientIsSpider ( )
Returns true is the client/agent is a spider/indexer or some other non-human interface, determined
by checking the user agent against a list of known spiders.
=cut
sub clientIsSpider {
my $self = shift;
my $userAgent = $self->user_agent;
return 1 if $userAgent eq ''
|| $userAgent =~ m<(^wre\/| # the WRE wget's http://localhost/ every 2-3 minutes 24 hours a day...
^morpheus|
libwww|
s[pb]ider|
bot|
robo|
sco[ou]t|
crawl|
miner|
reaper|
finder|
search|
engine|
download|
fetch|
scan|
slurp)>ix;
return 0;
}
#-------------------------------------------------------------------
=head2 callerIsSearchSite ( )
Returns true if the remote address matches a site which is a known indexer or spider.
=cut
sub callerIsSearchSite {
my $self = shift;
my $remoteAddress = $self->address;
return 1 if $remoteAddress =~ /203\.87\.123\.1../ # Blaiz Enterprise Rawgrunt search
|| $remoteAddress =~ /123\.113\.184\.2../ # Unknown Yahoo Robot
|| $remoteAddress == '';
return 0;
}
#-------------------------------------------------------------------
=head2 new_response ()
Creates a new L<WebGUI::Session::Response> object.
@ -32,9 +94,29 @@ sub new_response {
return WebGUI::Session::Response->new(@_);
}
#-------------------------------------------------------------------
=head2 requestNotViewed ( )
Returns true is the client/agent is a spider/indexer or some other non-human interface
=cut
sub requestNotViewed {
my $self = shift;
return $self->clientIsSpider();
# || $self->callerIsSearchSite(); # this part is currently left out because
# it has minimal effect and does not manage
# IPv6 addresses. it may be useful in the
# future though
}
# This is only temporary
sub TRACE {
shift->env->{'psgi.errors'}->print(join '', @_, "\n");
}
1;
1;

2
lib/WebGUI/Session/Style.pm
View file

@ -131,7 +131,7 @@ sub useMobileStyle {
if (! $session->setting->get('useMobileStyle')) {
return $self->{_useMobileStyle} = 0;
}
my $ua = $session->env->get('HTTP_USER_AGENT');
my $ua = $session->request->user_agent;
for my $mobileUA (@{ $self->session->config->get('mobileUserAgents') }) {
if ($ua =~ m/$mobileUA/) {
return $self->{_useMobileStyle} = 1;

20
lib/WebGUI/Session/Url.pm
View file

@ -136,7 +136,7 @@ sub extras {
my $cdnCfg = $self->session->config->get('cdn');
if ( $cdnCfg and $cdnCfg->{'enabled'} and $cdnCfg->{'extrasCdn'} ) {
unless ( $path and grep $path =~ m/$_/, @{ $cdnCfg->{'extrasExclude'} } ) {
if ($cdnCfg->{'extrasSsl'} && $self->session->env->sslRequest) {
if ($cdnCfg->{'extrasSsl'} && $self->session->request->secure) {
$url = $cdnCfg->{'extrasSsl'};
}
else {
@ -258,7 +258,7 @@ Returns the URL of the page this request was refered from (no gateway, no query
sub getRefererUrl {
my $self = shift;
my $referer = $self->session->env->get("HTTP_REFERER");
my $referer = $self->session->request->referer;
return undef unless ($referer);
my $url = $referer;
my $gateway = $self->session->config->get("gateway");
@ -289,20 +289,20 @@ is not passed in, it will attempt to get one from the L<page> method, or finally
sub forceSecureConnection {
my $self = shift;
my $url = shift;
my ($conf, $env, $http) = $self->session->quick(qw(config env http));
my ($conf, $http) = $self->session->quick(qw(config http));
if ($conf->get("sslEnabled") && !$env->sslRequest){
if ($conf->get("sslEnabled") && ! $self->session->request->secure){
$url = $self->session->url->page if(! $url);
$url = $env->get('QUERY_STRING') if(! $url);
my $query_string = $self->session->request->env->{'QUERY_STRING'};
$url = $url || $self->page || $query_string;
my $siteURL = $self->getSiteURL();
if($url !~ /^$siteURL/i){
$url = $siteURL . $url;
}
if($env->get('QUERY_STRING')){
$url .= "?". $env->get('QUERY_STRING');
if($query_string){
$url .= "?". $query_string;
}
if($url =~ /^http/i) {
$url =~ s/^https?/https/i;
@ -347,14 +347,14 @@ sub getSiteURL {
unless ($self->{_siteUrl}) {
my $site = "";
my $sitenames = $self->session->config->get("sitename");
my ($http_host,$currentPort) = split(':', $self->session->env->get("HTTP_HOST"));
my ($http_host,$currentPort) = split(':', $self->session->request->env->{"HTTP_HOST"});
if ($self->session->setting->get("hostToUse") eq "HTTP_HOST" and isIn($http_host,@{$sitenames})) {
$site = $http_host;
} else {
$site = $sitenames->[0];
}
my $proto = "http://";
if ($self->session->env->sslRequest) {
if ($self->session->request->secure) {
$proto = "https://";
}
my $port = "";

4
lib/WebGUI/Session/Var.pm
View file

@ -182,7 +182,7 @@ sub new {
my $time = time();
my $timeout = $session->setting->get("sessionTimeout");
$self->{_var}{lastPageView} = $time;
$self->{_var}{lastIP} = $session->env->getIp;
$self->{_var}{lastIP} = $session->request->address;
$self->{_var}{expires} = $time + $timeout;
if ($self->{_var}{nextCacheFlush} > 0 && $self->{_var}{nextCacheFlush} < $time) {
delete $self->{_var}{nextCacheFlush};
@ -247,7 +247,7 @@ sub start {
$self->{_var} = {
expires => $time + $timeout,
lastPageView => $time,
lastIP => $session->env->getIp,
lastIP => $session->request->address,
adminOn => 0,
userId => $userId
};