1package Protocol::HTTP2::Upgrade;
2use strict;
3use warnings;
4use Protocol::HTTP2;
5use Protocol::HTTP2::Constants qw(:frame_types :errors :states);
6use Protocol::HTTP2::Trace qw(tracer);
7use MIME::Base64 qw(encode_base64url decode_base64url);
8
9#use re 'debug';
10my $end_headers_re = qr/\G.+?\x0d?\x0a\x0d?\x0a/s;
11my $header_re      = qr/\G[ \t]*(.+?)[ \t]*\:[ \t]*(.+?)[ \t]*\x0d?\x0a/;
12
13sub upgrade_request {
14    my ( $con, %h ) = @_;
15    my $request = sprintf "%s %s HTTP/1.1\x0d\x0aHost: %s\x0d\x0a",
16      $h{':method'}, $h{':path'},
17      $h{':authority'};
18    while ( my ( $h, $v ) = splice( @{ $h{headers} }, 0, 2 ) ) {
19        next if grep { lc($h) eq $_ } (qw(connection upgrade http2-settings));
20        $request .= $h . ': ' . $v . "\x0d\x0a";
21    }
22    $request .= join "\x0d\x0a",
23      'Connection: Upgrade, HTTP2-Settings',
24      'Upgrade: ' . Protocol::HTTP2::ident_plain,
25      'HTTP2-Settings: '
26      . encode_base64url( $con->frame_encode( SETTINGS, 0, 0, {} ) ),
27      '', '';
28}
29
30sub upgrade_response {
31
32    join "\x0d\x0a",
33      "HTTP/1.1 101 Switching Protocols",
34      "Connection: Upgrade",
35      "Upgrade: " . Protocol::HTTP2::ident_plain,
36      "", "";
37
38}
39
40sub decode_upgrade_request {
41    my ( $con, $buf_ref, $buf_offset, $headers_ref ) = @_;
42
43    pos($$buf_ref) = $buf_offset;
44
45    # Search end of headers
46    return 0 if $$buf_ref !~ /$end_headers_re/g;
47    my $end_headers_pos = pos($$buf_ref) - $buf_offset;
48
49    pos($$buf_ref) = $buf_offset;
50
51    # Request
52    return undef if $$buf_ref !~ m#\G(\w+) ([^ ]+) HTTP/1\.1\x0d?\x0a#g;
53    my ( $method, $uri ) = ( $1, $2 );
54
55    # TODO: remove after http2 -> http/1.1 headers conversion implemented
56    push @$headers_ref, ":method", $method;
57    push @$headers_ref, ":path",   $uri;
58    push @$headers_ref, ":scheme", 'http';
59
60    my $success = 0;
61
62    # Parse headers
63    while ( $success != 0b111 && $$buf_ref =~ /$header_re/gc ) {
64        my ( $header, $value ) = ( lc($1), $2 );
65
66        if ( $header eq "connection" ) {
67            my %h = map { $_ => 1 } split /\s*,\s*/, lc($value);
68            $success |= 0b001
69              if exists $h{'upgrade'} && exists $h{'http2-settings'};
70        }
71        elsif (
72            $header eq "upgrade" && grep { $_ eq Protocol::HTTP2::ident_plain }
73            split /\s*,\s*/,
74            $value
75          )
76        {
77            $success |= 0b010;
78        }
79        elsif ( $header eq "http2-settings"
80            && defined $con->frame_decode( \decode_base64url($value), 0 ) )
81        {
82            $success |= 0b100;
83        }
84        else {
85            push @$headers_ref, $header, $value;
86        }
87    }
88
89    return undef unless $success == 0b111;
90
91    # TODO: method POST also can contain data...
92
93    return $end_headers_pos;
94
95}
96
97sub decode_upgrade_response {
98    my ( $con, $buf_ref, $buf_offset ) = @_;
99
100    pos($$buf_ref) = $buf_offset;
101
102    # Search end of headers
103    return 0 if $$buf_ref !~ /$end_headers_re/g;
104    my $end_headers_pos = pos($$buf_ref) - $buf_offset;
105
106    pos($$buf_ref) = $buf_offset;
107
108    # Switch Protocols failed
109    return undef if $$buf_ref !~ m#\GHTTP/1\.1 101 .+?\x0d?\x0a#g;
110
111    my $success = 0;
112
113    # Parse headers
114    while ( $success != 0b11 && $$buf_ref =~ /$header_re/gc ) {
115        my ( $header, $value ) = ( lc($1), $2 );
116
117        if ( $header eq "connection" && lc($value) eq "upgrade" ) {
118            $success |= 0b01;
119        }
120        elsif ( $header eq "upgrade" && $value eq Protocol::HTTP2::ident_plain )
121        {
122            $success |= 0b10;
123        }
124    }
125
126    return undef unless $success == 0b11;
127
128    return $end_headers_pos;
129}
130
1311;
132