<%
' This is originally from http://www.wc.cc.va.us/dtod/zope/, David Carter Tod
' Modified by Andy McKay, http://www.zope.org/Members/andym
' Feb 20, 2002
' License ZPL http://www.zope.org
' (Didnt spot any license or copyright in the original)
' The approach here is a little like how I imagine mod-rewrite works:
' You define this page as the error handler for File Not Found (404 and 405)
' 404 is a GET not found and 405 is a POST not found
' IIS does NOT send back the 404 header initially, but rather
' it passes the handling off to this page. This is not well-documented
' and somewhat non-standard, but very useful.
' The originally requested page headers and request parameters are
' extracted and then reformulated into a new request to the Zope server
' which can be on the same machine or even somewhere else
' The request is made via HTTP and the result returned to the client
' as if it came from this server.
' There is an obvious performance trade-off here since a single request
' actually generates another request to the same machine on a different
' port, but in practice, it's very fast. Also the technique means that
' the Zope machine could in fact be somewhere else
' One unresolved issue is that of URLs (and images). One solution is to fix them in
' this ASP code with a global Replace, but that's open to potential
' problems. This code doesn't seem to handle requests for Zope images. I think
' it could, but right now it doesn't. The most obvious solution is to make sure the
' urls are all good in the page sent back by Zope, e.g. image refs are either to correct
' location (absolute not relative) either on IIS server or in Zope. Also internal urls should be
' relative, not absolute (except for images). Let me rephrase:
' 1. Non-text refs should be absolute
' 2. Text refs should be relative
' I don't know how this is done in Zope, but I'm sure it can be...
'Option Explicit
'Response.buffer=true
Dim objXMLHttp ' server-safe xmlhttpobj - req. latest version of MS XMLParser 3.0 sp1 as of writing
Dim strResponse ' response from the Zope server
Dim reqMeth ' Request method of orginal request
Dim reqPath ' Path requested of orginal request
Dim reqUser ' User if any of orginal request
Dim reqPass ' Password if any of orginal request
Dim errArray ' An array created by splitting the Query String of the orginal request
' at the semi-colon. This gives the originally requested URL.
Dim strResponseHeaders ' HTTP headers sent back by the Zope server
Dim strKey ' Originally used to iterate through header collection, but no longer done.
Dim IISAdr ' hostname of the IIS server
Dim ZopeAdr ' hostname of the Zope server
Dim ZopeAdrLastBit
'AndyM
'Ok do this in a format that is
IISAdr="intranet.activestate.com" 'this the IIS port
ZopeAdrLastBit = "/VirtualHostBase/https/intranet.activestate.com:443/VirtualHostRoot" ' this is what VHM needs, im using 443, but you will probably want 80
ZopeAdr="intranet.activestate.com:1500" & ZopeAdrLastBit ' destination Zope
reqMeth=Request.ServerVariables("REQUEST_METHOD") & ""
reqUser=Request.ServerVariables("AUTH_USER") & ""
reqPass=Request.ServerVariables("AUTH_PASSWORD") & ""
' I could probably use Instr here, but this works...
errArray = split(request.servervariables("QUERY_STRING"),";")
reqPath = errArray(1)
' The following was for the debugging phase.
'Response.write("I'm debugging right now." & Request.ServerVariables("ALL_RAW") & "")
'Response.write(reqMeth) & "
"
'Response.write(reqPath) & "
"
'Response.write(reqUser) & "
"
'Response.write(reqPass) & "
"
'Response.write(request) & "
"
' AndyM
' oh my god, I cant seem to stop it caching on
' this is a hideous, horrible hack that is so stupid
' why would I have to do this, ive read through msdn time and time again
' so this hacks adds a variable called _aspCache (not accessible via dtml)
' which is the current date and time plus a random number
Randomize()
Dim Num
Dim qsDivider
Num = Server.UrlEncode(FormatDateTime(Now, 0)) & CStr(Rnd())
reqPath = Replace(reqPath, IISAdr, ZopeAdr, 1, -1, 1)
qsDivider = "?"
if instr(reqPath,"?") then
qsDivider = "&"
end if
reqPath = reqPath & qsDivider & "_aspCrap=" & Num
'/AndyM
' The following section is unnecessary, I think, but left in, just in case I need it for POST handling
'Dim vntPostedData, lngCount
'lngCount = Request.TotalBytes
'vntPostedData = Request.BinaryRead(lngCount)
' This is where the new request is generated
Set objXMLHttp = Server.CreateObject("Microsoft.XMLHTTP")
objXMLHttp.Open reqMeth, reqPath, False, reqUser, reqPass
' Next set any pertinent request headers
dim hArr, i, colPos, hName, hValue
hArr=split(Request.ServerVariables("ALL_RAW"), vbnewline)
for each i in hArr
if not trim(i)="" then
colPos=instr(i, ":")
hName=Trim(left(i, colPos-1))
hValue=Trim(mid(i, colPos+1))
if NOT LCase(hName)="host" then
objXMLHttp.setRequestHeader hName, hValue
end if
end if
next
' AndyM
' Send the request
' post binart data if there is a post
if lcase(reqMeth)="post" then
binarydata = Request.binaryread(Request.TotalBytes)
objXMLHttp.send binarydata
else
objXMLHttp.send
end if
'/AndyM
' Copy the response status headers
Response.Status = objXMLHttp.status & " " & objXMLHttp.statusText
' Copy the other headers
strResponseHeaders=objXMLHttp.getallResponseHeaders()
' Response.write "
" & strResponseHeaders & "
" ' debugging code
' split and then iterate with response.addheader
'dim hArr, i, colPos, hName, hValue
hArr=split(strResponseHeaders, vbnewline)
for each i in hArr
if not trim(i)="" then
colPos=instr(i, ":")
hName=Trim(left(i, colPos-1))
hValue=Trim(mid(i, colPos+1))
if LCase(hName)="www-authenticate" then ' In fact, we're going with just this header, but
' others might be needed later.
response.addheader hName, hValue
end if
end if
next
'AndyM write in binary
Response.BinaryWrite(objXMLHttp.responseBody)
'/AndyM
%>