… | |
… | |
412 | |
412 | |
413 | \@cookies |
413 | \@cookies |
414 | } |
414 | } |
415 | |
415 | |
416 | # parse set_cookie header into jar |
416 | # parse set_cookie header into jar |
417 | sub cookie_jar_set_cookie($$) { |
417 | sub cookie_jar_set_cookie($$$) { |
418 | my ($jar, $set_cookie) = @_; |
418 | my ($jar, $set_cookie, $uhost) = @_; |
419 | |
419 | |
420 | for ($set_cookie) { |
420 | for ($set_cookie) { |
421 | # parse NAME=VALUE |
421 | # parse NAME=VALUE |
422 | my @kv; |
422 | my @kv; |
423 | |
423 | |
… | |
… | |
472 | } else { |
472 | } else { |
473 | $cdom = $uhost; |
473 | $cdom = $uhost; |
474 | } |
474 | } |
475 | |
475 | |
476 | # store it |
476 | # store it |
477 | $arg{cookie_jar}{version} = 1; |
477 | $jar->{version} = 1; |
478 | $arg{cookie_jar}{$cdom}{$cpath}{$name} = \%kv; |
478 | $jar->{$cdom}{$cpath}{$name} = \%kv; |
479 | |
479 | |
480 | redo if /\G\s*,/gc; |
480 | redo if /\G\s*,/gc; |
481 | } |
481 | } |
482 | } |
|
|
483 | } |
482 | } |
484 | |
483 | |
485 | # continue to parse $_ for headers and place them into the arg |
484 | # continue to parse $_ for headers and place them into the arg |
486 | sub parse_hdr() { |
485 | sub parse_hdr() { |
487 | my %hdr; |
486 | my %hdr; |
… | |
… | |
735 | $hdr{OrigReason} = $hdr{Reason}; $hdr{Reason} = $_[2]; |
734 | $hdr{OrigReason} = $hdr{Reason}; $hdr{Reason} = $_[2]; |
736 | } |
735 | } |
737 | |
736 | |
738 | # set-cookie processing |
737 | # set-cookie processing |
739 | if ($arg{cookie_jar}) { |
738 | if ($arg{cookie_jar}) { |
740 | cookie_jar_set_cookie $arg{cookie_jar}, $hdr{"set-cookie"}; |
739 | cookie_jar_set_cookie $arg{cookie_jar}, $hdr{"set-cookie"}, $uhost; |
|
|
740 | } |
741 | |
741 | |
742 | if ($redirect && exists $hdr{location}) { |
742 | if ($redirect && exists $hdr{location}) { |
743 | # we ignore any errors, as it is very common to receive |
743 | # we ignore any errors, as it is very common to receive |
744 | # Content-Length != 0 but no actual body |
744 | # Content-Length != 0 but no actual body |
745 | # we also access %hdr, as $_[1] might be an erro |
745 | # we also access %hdr, as $_[1] might be an erro |