[interchange] Refactor cookie-setting routine to avoid double ; and extra string copying
Jon Jensen <[email protected]> Fri, 13 Jan 2017 16:56:22 +0000
| Newsgroups | gmane.comp.web.interchange.cvs |
|---|---|
| Message-ID | <[email protected]> |
commit c79b9cf54e03d382d193d799cab9a758cd79ec83 Author: Jon Jensen <[email protected]> Date: Wed Jan 11 09:40:19 2017 -0700 Refactor cookie-setting routine to avoid double ; and extra string copying And use canonical capitalization. lib/Vend/Server.pm | 44 ++++++++++++++++++++++++-------------------- 1 files changed, 24 insertions(+), 20 deletions(-) --- diff --git a/lib/Vend/Server.pm b/lib/Vend/Server.pm index 425b6b4..0d9c852 100644 --- a/lib/Vend/Server.pm +++ b/lib/Vend/Server.pm @@ -564,8 +564,7 @@ sub parse_multipart { sub create_cookie { - my($domain,$path) = @_; - my $out; + my ($default_domain, $default_path) = @_; if ($Vend::suppress_cookies) { #::logDebug('explicitly clearing the cookie jar (nom nom nom)'); @@ -582,7 +581,7 @@ sub create_cookie { my @jar; push @jar, [ - ($::Instance->{CookieName} || 'MV_SESSION_ID'), + $::Instance->{CookieName} || 'MV_SESSION_ID', defined $::Instance->{ClearCookie} ? '' : $Vend::SessionName, $Vend::Expire || undef, undef, @@ -592,17 +591,19 @@ sub create_cookie { unless $Vend::CookieID; push @jar, @{$::Instance->{Cookies}} if defined $::Instance->{Cookies}; - $out = ''; - foreach my $cookie (@jar) { - my ($name, $value, $expire, $d, $p, $secure) = @$cookie; - $d = $domain if ! $d; - $p = $path if ! $p; -#::logDebug("create_cookie: name=$name value=$value expire=$expire"); +#::logDebug("create_cookie jar=" . ::uneval(\@jar)); + + my @out; + for my $cookie (@jar) { + my ($name, $value, $expire, $domain, $path, $secure) = @$cookie; + $domain ||= $default_domain; + $path ||= $default_path; +#::logDebug("create_cookie: name=$name value=$value expire=$expire domain=$domain path=$path secure=$secure"); $value = Vend::Interpolate::esc($value) if $value !~ /^[-\w:.]+$/; - $out .= "Set-Cookie: $name=$value;"; - $out .= " path=$p;"; - $out .= " domain=" . $d . ";" if $d; + my @pieces = "Set-Cookie: $name=$value"; + push @pieces, "Path=$path"; + push @pieces, "Domain=$domain" if $domain; if (defined $expire or $Vend::Expire) { my $expstring; if(! $expire) { @@ -611,16 +612,19 @@ sub create_cookie { elsif($expire =~ /\s\S+\s/) { $expstring = $expire; } - $expstring = strftime "%a, %d-%b-%Y %H:%M:%S GMT ", gmtime($expire) - unless $expstring; - $expstring = "expires=$expstring" if $expstring !~ /^\s*expires=/i; - $expstring =~ s/^\s*/ /; - $out .= $expstring; + $expstring ||= strftime("%a, %d-%b-%Y %H:%M:%S GMT", gmtime($expire)); + $expstring =~ s/^\s+//; + $expstring = "Expires=$expstring" if $expstring !~ /^expires=/i; + push @pieces, $expstring; } - $out .= '; secure' if $secure; - $out .= '; HttpOnly' if $::Pragma->{set_httponly}; - $out .= "\r\n"; + push @pieces, 'Secure' if $secure; + push @pieces, 'HttpOnly' if $::Pragma->{set_httponly}; + my $header = join('; ', @pieces); +#::logDebug("create_cookie made header: $header"); + push @out, $header; } + + my $out = join('', map { "$_\r\n" } @out); return $out; }