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