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