AxKit2

 view release on metacpan or  search on metacpan

lib/AxKit2/HTTPHeaders.pm  view on Meta::CPAN

            #     token          = 1*<any CHAR except CTLs or separators>

            $last_header = lc($1);
            if (defined $self->{headers}{$last_header}) {
                if ($last_header eq "set-cookie") {
                    # cookie spec doesn't allow merged headers for set-cookie,
                    # so instead we do this hack so to_string below does the right
                    # thing without needing to be arrayref-aware or such.  also
                    # this lets client code still modify/delete this data
                    # (but retrieving the value of "set-cookie" will be broken)
                    $self->{headers}{$last_header} .= "\r\nSet-Cookie: $2";
                } else {
                    # normal merged header case (according to spec)
                    $self->{headers}{$last_header} .= ", $2";
                }
            } else {
                $self->{headers}{$last_header} = $2;
                $self->{origcase}{$last_header} = $1;
                push @{$self->{hdorder}}, $last_header;
            }
        } else {

lib/AxKit2/HTTPHeaders.pm  view on Meta::CPAN

=cut

sub request_uri {
    my AxKit2::HTTPHeaders $self = shift;
    @_ and $self->{uri} = shift;
    return $self->{uri};
}

*uri = \&request_uri;

# Parse the Cookie header.
sub parse_cookies {
    my AxKit2::HTTPHeaders $self = shift;
    my $raw_cookies = $self->header('Cookie') || '';
    $self->{parsed_cookies} = {};
    foreach (split(/;\s+/, $raw_cookies)) {
        my ($key, $value) = split("=", $_, 2);
        my (@values) = map { uri_decode($_) } split(/&/, $value);
        $key = uri_decode($key);
        $self->{parsed_cookies}{$key} = \@values;
    }
}

# From RFC-2109

lib/AxKit2/HTTPHeaders.pm  view on Meta::CPAN

        my %params = @_;
        
        # special case for "secure"
        my @params = delete($params{secure}) ? ("secure") : ();
        # rest are key-value pairs
        push @params, map { "$_=$params{$_}" } keys %params;
        
        my $key = uri_encode($name);
        my $cookie = "$key=" . join("&", map uri_encode($_), ref($value) ? @$value : $value);
        $cookie = join('; ', $cookie, @params);
        if (my $oldcookie = $self->header('Set-Cookie')) {
            $cookie = "$oldcookie, $cookie";
        }
        $self->header('Set-Cookie', $cookie);
        $self->header('Expires', http_date(0)) unless $self->header('Expires');
        return;
    }
    die "Cannot extract cookies from the response"
        if $self->{type} eq 'res';
    $self->parse_cookies unless $self->{parsed_cookies};
    if (exists $self->{parsed_cookies}{$name}) {
        return wantarray ? @{$self->{parsed_cookies}{$name}} : $self->{parsed_cookies}{$name}[-1];
    }
}

plugins/demo/webmail  view on Meta::CPAN

    my $client  = $self->client;
    my $headers = $client->headers_in;
    
    $client->notes('mail_response', DECLINED);
    
    my $cookie  = $headers->cookie('mail_session');
    
    # No cookie, skip to auth
    return DECLINED unless $cookie;
    
    # Cookie invalid/expired, skip to auth
    my $login = eval { decookie($cookie) };
    if ($@) {
        $self->log(LOGINFO, $@);
        $client->notes('cookie_failure', $@);
        return DECLINED;
    }
    
    my $server = shift @{ $imap_cache{$login} || [] };
    if ($server) {
        my $bref = $server->read(1);