[interchange-cvs] interchange - jon modified lib/Vend/Server.pm

[interchange-core@interchange.redhat.com]

User:      jon
Date:      2002-05-07 16:45:35 GMT
Modified:  lib/Vend Tag: STABLE_4_8-branch Server.pm
Log:
Backport patch from 4.9 development line that makes SOAP server
return proper headers, which not only makes it compliant with the
SOAP standard, but also makes it work with the more recent versions
of SOAP::Lite, including the latest 0.55 with the security fix.

Revision  Changes    Path
No                   revision



No                   revision



2.0.2.2   +13 -2     interchange/lib/Vend/Server.pm


rev 2.0.2.2, prev_rev 2.0.2.1
Index: Server.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/Server.pm,v
retrieving revision 2.0.2.1
retrieving revision 2.0.2.2
diff -u -u -r2.0.2.1 -r2.0.2.2
--- Server.pm	24 Jan 2002 05:07:01 -0000	2.0.2.1
+++ Server.pm	7 May 2002 16:45:35 -0000	2.0.2.2
@@ -1,6 +1,6 @@
 # Vend::Server - Listen for Interchange CGI requests as a background server
 #
-# $Id: Server.pm,v 2.0.2.1 2002/01/24 05:07:01 jon Exp $
+# $Id: Server.pm,v 2.0.2.2 2002/05/07 16:45:35 jon Exp $
 #
 # Copyright (C) 1996-2002 Red Hat, Inc. <interchange@redhat.com>
 #
@@ -25,7 +25,7 @@
 package Vend::Server;
 
 use vars qw($VERSION);
-$VERSION = substr(q$Revision: 2.0.2.1 $, 10);
+$VERSION = substr(q$Revision: 2.0.2.2 $, 10);
 
 use POSIX qw(setsid strftime);
 use Vend::Util;
@@ -1838,7 +1838,18 @@
 					->handle;
 			}
 
+			unless ($Vend::StatusLine =~ m{^HTTP/}) {
+				my $status = $Vend::StatusLine =~ /(?:^|\n)Status:\s+(.*)/i
+					? "$1" : "200 OK";
+				$Vend::StatusLine = "HTTP/1.0 $status\r\n" . $Vend::StatusLine;
+			}
+			$Vend::StatusLine .= "\r\nContent-Type: text/xml\r\n"
+				unless $Vend::StatusLine =~ /^Content-Type:/im;
+
+			print MESSAGE canon_status($Vend::StatusLine);
 			print MESSAGE $result;
+			undef $Vend::StatusLine;
+			$Vend::ResponseMade = 1;
 			close MESSAGE;
 #::logDebug("SOAP port=$p n=$n unix=$unix_socket{$p} pid=$$ c=$c time=" . join '|', times);
 		}