"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "lib/Vend/Server.pm" between
interchange-5.8.2.tar.gz and interchange-5.10.0.tar.gz

About: Interchange is an Electronic commerce system (supports SSL, PGP/GPG).

Server.pm  (interchange-5.8.2)	:	Server.pm  (interchange-5.10.0)
skipping to change at line 26		skipping to change at line 26
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the		# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.		# GNU General Public License for more details.
#		#
# You should have received a copy of the GNU General Public		# You should have received a copy of the GNU General Public
# License along with this program; if not, write to the Free		# License along with this program; if not, write to the Free
# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,		# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
# MA 02110-1301 USA.		# MA 02110-1301 USA.
package Vend::Server;		package Vend::Server;
use vars qw($VERSION);		use vars qw($VERSION $Has_JSON);
$VERSION = '2.107';		$VERSION = '2.107';
use Cwd;		use Cwd;
use POSIX qw(setsid strftime);		use POSIX qw(setsid strftime);
use Vend::Util;		use Vend::Util;
use Vend::CharSet qw/ to_internal decode_urlencode default_charset /;		use Vend::CharSet qw/ to_internal decode_urlencode default_charset /;
use Fcntl;		use Fcntl;
use Errno qw/:POSIX/;		use Errno qw/:POSIX/;
use Config;		use Config;
use Socket;		use Socket;
use Symbol;		use Symbol;
use strict;		use strict;
		{
		local $@;
		eval {
		require JSON;
		};
		if ($@) {
		if ($@ !~ /^Can't locate JSON/) {
		::logGlobal("Error loading JSON module: $@");
		}
		}
		else {
		$Has_JSON = 1;
		}
		}
no warnings qw(uninitialized);		no warnings qw(uninitialized);
my $ppidsub = sub { return getppid };		my $ppidsub = sub { return getppid };
sub new {		sub new {
my ($class, $fh, $env, $entity) = @_;		my ($class, $fh, $env, $entity) = @_;
populate($env);		populate($env);
my $http = {		my $http = {
fh => $fh,		fh => $fh,
entity => $entity,		entity => $entity,
skipping to change at line 263		skipping to change at line 279
($::IV, $::VN, $::SV) = $g->{VarName}		($::IV, $::VN, $::SV) = $g->{VarName}
? ($g->{IV}, $g->{VN}, $g->{IgnoreMultiple})		? ($g->{IV}, $g->{VN}, $g->{IgnoreMultiple})
: ($Global::IV, $Global::VN, $Global::IgnoreMultiple);		: ($Global::IV, $Global::VN, $Global::IgnoreMultiple);
# Vend::ModPerl has already handled GET/POST parsing		# Vend::ModPerl has already handled GET/POST parsing
return if $Global::mod_perl;		return if $Global::mod_perl;
#::logDebug("CGI::query_string=" . $CGI::query_string);		#::logDebug("CGI::query_string=" . $CGI::query_string);
#::logDebug("entity=" . ${$h->{entity}});		#::logDebug("entity=" . ${$h->{entity}});
		#::logDebug("request_method=$CGI::request_method");
		#::logDebug("content_type=$CGI::content_type");
#::logDebug("Check robot UA=$Global::RobotUA IP=$Global::RobotIP");		#::logDebug("Check robot UA=$Global::RobotUA IP=$Global::RobotIP");
if ($Global::RobotIP and $CGI::remote_addr =~ $Global::RobotIP) {		if ($Global::RobotIP and $CGI::remote_addr =~ $Global::RobotIP) {
#::logDebug("It is a robot by IP!");		#::logDebug("It is a robot by IP!");
$Vend::Robot = 1;		$Vend::Robot = 1;
}		}
elsif ($Global::HostnameLookups && $Global::RobotHost) {		elsif ($Global::HostnameLookups && $Global::RobotHost) {
if (!$CGI::remote_host && $CGI::remote_addr) {		if (!$CGI::remote_host && $CGI::remote_addr) {
$CGI::remote_host = gethostbyaddr(Socket::inet_aton($CGI: :remote_addr),Socket::AF_INET);		$CGI::remote_host = gethostbyaddr(Socket::inet_aton($CGI: :remote_addr),Socket::AF_INET);
$CGI::host = $CGI::remote_host || $CGI::remote_addr;		$CGI::host = $CGI::remote_host || $CGI::remote_addr;
skipping to change at line 323		skipping to change at line 341
my $h = shift;		my $h = shift;
my $request_method = "\U$CGI::request_method";		my $request_method = "\U$CGI::request_method";
if ($request_method eq 'POST') {		if ($request_method eq 'POST') {
$::Instance->{Volatile} = 1;		$::Instance->{Volatile} = 1;
#::logDebug("content type header: " . $CGI::content_type);		#::logDebug("content type header: " . $CGI::content_type);
## check for valid content type		## check for valid content type
if ($CGI::content_type =~ m{^(?:multipart/form-data|application/x -www-form-urlencoded|application/xml|application/json)\b}i) {		if ($CGI::content_type =~ m{^(?:multipart/form-data|application/x -www-form-urlencoded|application/xml|application/json)\b}i) {
parse_post(\$CGI::query_string, 1)		parse_post(\$CGI::query_string, 1)
if $Global::TolerateGet;		if $Global::TolerateGet;
parse_post($h->{entity});		if ($Global::EnableJSONPost && $CGI::content_type =~ m{^a
		pplication/json\s*(?:;|$)}i) {
		if (!$Has_JSON) {
		::logGlobal('No POST support for applicat
		ion/json without installing JSON module');
		goto INVALIDPOST;
		}
		else {
		$CGI::post_ref = $h->{entity};
		undef $CGI::json_ref;
		eval {
		$CGI::json_ref = JSON::from_json(
		$$CGI::post_ref);
		#::logDebug('json: %s', ::uneval($CGI::json_ref));
		if ($Global::UnpackJSON && ref $C
		GI::json_ref eq 'HASH') {
		@CGI::values{keys %$CGI::
		json_ref} = values %$CGI::json_ref;
		}
		};
		logError("Error parsing JSON data: $@") i
		f $@;
		}
		}
		else {
		parse_post($h->{entity});
		}
}		}
else {		else {
## invalid content type for POST		## invalid content type for POST
## XXX we may want to be a little more forgiving here		## XXX we may want to be a little more forgiving here
my $msg = ::get_locale_message(415, "Unsupported Content-		INVALIDPOST:
Type for POST method");		{
my $content_type = $msg =~ /<html/i ? 'text/html' : 'text		my $msg = ::get_locale_message(415, "Unsupported
/plain';		Content-Type for POST method");
my $len = length($msg);		my $content_type = $msg =~ /<html/i ? 'text/html'
$Vend::StatusLine = <<EOF;		: 'text/plain';
		my $len = length($msg);
		$Vend::StatusLine = <<EOF;
Status: 415 Unsupported Media Type		Status: 415 Unsupported Media Type
Content-Type: $content_type		Content-Type: $content_type
Content-Length: $len		Content-Length: $len
EOF		EOF
respond('', \$msg);		respond('', \$msg);
die($msg);		die($msg);
		}
}		}
}		}
elsif ($request_method eq 'PUT') {		elsif ($request_method eq 'PUT') {
#::logDebug("Put operation.");		#::logDebug("Put operation.");
parse_post(\$CGI::query_string);		parse_post(\$CGI::query_string);
$CGI::put_ref = $h->{entity};		$CGI::put_ref = $h->{entity};
#::logDebug("Put contents: $$CGI::put_ref");		#::logDebug("Put contents: $$CGI::put_ref");
$$CGI::put_ref =~ s/^\s*--+\s+begin\s+content\s+--+\r?\n//i;		$$CGI::put_ref =~ s/^\s*--+\s+begin\s+content\s+--+\r?\n//i;
$$CGI::put_ref =~ s/^\r?\n--+\s+end\s+content\s+--+\s*$//i;		$$CGI::put_ref =~ s/^\r?\n--+\s+end\s+content\s+--+\s*$//i;
}		}
End of changes. 6 change blocks.
10 lines changed or deleted		59 lines changed or added

---