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

interchange-core@interchange.redhat.com interchange-core@interchange.redhat.com
Wed Apr 17 13:50:01 2002


User:      jon
Date:      2002-04-17 17:49:52 GMT
Modified:  lib/Vend Server.pm
Log:
Send HTTP headers in SOAP response, since we're using HTTP transport.

This keeps proxies and firewalls from rejecting the response as invalid
HTTP, and allows the server to give Status of 500 for errors, or 200 for
ok, as per SOAP 1.1 protocol.

Revision  Changes    Path
2.3       +13 -2     interchange/lib/Vend/Server.pm


rev 2.3, prev_rev 2.2
Index: Server.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/Server.pm,v
retrieving revision 2.2
retrieving revision 2.3
diff -u -u -r2.2 -r2.3
--- Server.pm	3 Mar 2002 00:56:47 -0000	2.2
+++ Server.pm	17 Apr 2002 17:49:52 -0000	2.3
@@ -1,6 +1,6 @@
 # Vend::Server - Listen for Interchange CGI requests as a background server
 #
-# $Id: Server.pm,v 2.2 2002/03/03 00:56:47 kwalsh Exp $
+# $Id: Server.pm,v 2.3 2002/04/17 17:49:52 jon Exp $
 #
 # Copyright (C) 1996-2001 Red Hat, Inc. <interchange@redhat.com>
 #
@@ -25,7 +25,7 @@
 package Vend::Server;
 
 use vars qw($VERSION);
-$VERSION = substr(q$Revision: 2.2 $, 10);
+$VERSION = substr(q$Revision: 2.3 $, 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);
 		}