perl-embperl mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From "Gerald Richter" <rich...@ecos.de>
Subject Re: Patch to specify HTTP status for Location redirects
Date Wed, 05 Feb 2003 04:38:54 GMT


> The attached patch against Embperl-2.0b8 adds the ability to specify
> an HTTP status when setting the HTTP Location header.

Thanks for the patch, I will put it in 2.0b9

Gerald



>  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
>
>


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


Mime
View raw message