perl-embperl mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From David Hull <h...@paracel.com>
Subject Patch to specify HTTP status for Location redirects
Date Fri, 31 Jan 2003 19:31:35 GMT
The attached patch against Embperl-2.0b8 adds the ability to specify
an HTTP status when setting the HTTP Location header.  Currently in
Embperl when using:

  $http_headers_out{Location} = "/newlocation.html";

the HTTP status is set to the default value of 301.  With this patch,
however, it is possible to specify a two element array, the second
element of which gives the desired HTTP status:

  $http_headers_out{Location} = [ "/newlocation.html", 303 ];

This produces the following response from Apache:

HTTP/1.1 303 See Other
Date: Fri, 31 Jan 2003 00:12:51 GMT
Server: Apache/1.3.22 (Unix)  (Red-Hat/Linux) Embperl/2.0b8 mod_ssl/2.8.5 OpenSSL/0.9.6 mod_perl/1.24_01
location: /newlocation.html
Connection: close
Content-Type: text/html

The old behavior is unchanged when $http_headers_out{Location} is a
scalar or a one-element array.

I made a stab at doing the appropriate thing for the non-Apache branch
as well.  This doesn't (can't?) set the HTTP status, but ignores the
second element of the array if it is given.

I hope that someone other than me finds this useful.
-- 
David Hull

------------------------------------------------------------------------

diff -u -r Embperl-2.0b8.orig/epmain.c Embperl-2.0b8.safe/epmain.c
--- Embperl-2.0b8.orig/epmain.c	Mon Jun 24 12:22:52 2002
+++ Embperl-2.0b8.safe/epmain.c	Fri Jan 31 10:50:12 2003
@@ -828,8 +828,10 @@
 	/* loc = 0  =>  no location header found
 	 * loc = 1  =>  location header found
 	 * loc = 2  =>  location header + value found
+	 * loc = 3  =>  location header + value + status found
 	 */
  	I32	loc;
+	I32	loc_status = 301;
 
 	hv_iterinit (r -> pThread -> pHeaderHash) ;
 	while ((pEntry = hv_iternext (r -> pThread -> pHeaderHash)))
@@ -868,14 +870,16 @@
  		    for (i = 0; i <= len; i++) 
  			{
  			svp = av_fetch(arr, i, 0);
+			if (loc == 2)
+			    {
+			    loc = 3;
+			    loc_status = SvIV(*svp);
+			    break;
+			    }
  			p = SvPV(*svp, ldummy);
  			apr_table_add( r->pApacheReq->headers_out, apr_pstrdup(r->pApacheReq->pool,
pKey),
  				   apr_pstrdup(r->pApacheReq->pool, p ) );
- 			if (loc == 1) 
-			    {
-			    loc = 2;
-			    break;
- 			    }
+ 			if (loc == 1) loc = 2;
 			}
  		    } 
  		else 
@@ -885,7 +889,7 @@
 		    if (loc == 1) loc = 2;
 		    }
 
-		if (loc == 2) r->pApacheReq->status = 301;
+		if (loc >= 2) r->pApacheReq->status = loc_status;
 		}
 	    }
 
@@ -928,6 +932,11 @@
 	char * pContentType = "text/html";
         STRLEN ldummy ;
 
+	/* loc = 0  =>  no location header found
+	 * loc = 1  =>  location header found
+	 */
+ 	I32	loc;
+
 	r -> Component.pOutput -> nMarker = 0 ; /* output directly */
 
 	hv_iterinit (r -> pThread -> pHeaderHash) ;
@@ -935,9 +944,12 @@
 	    {
 	    pKey     = hv_iterkey (pEntry, &l) ;
 	    pHeader  = hv_iterval (r -> pThread -> pHeaderHash, pEntry) ;
+ 	    loc = 0;
 
 	    if (pHeader && pKey)
 		{			    
+		if (stricmp (pKey, "location") == 0)
+		    loc = 1;
  		if (SvROK(pHeader)  && SvTYPE(SvRV(pHeader)) == SVt_PVAV ) 
  		    {
  		    AV * arr = (AV *)SvRV(pHeader);
@@ -954,6 +966,7 @@
 			oputs (r, "\n") ;
 			if (r -> Component.Config.bDebug & dbgHeadersIn)
                 	    lprintf (r -> pApp,   "[%d]HDR:  %s: %s\n", r -> pThread ->
nPid, pKey, p) ; 
+			if (loc == 1) break;
 			}
  		    } 
 		else

---------------------------------------------------------------------
To unsubscribe, e-mail: embperl-unsubscribe@perl.apache.org
For additional commands, e-mail: embperl-help@perl.apache.org


Mime
View raw message