FM / WebSocket

/usr/share/usermin/vendor_perl/Protocol/WebSocket/

/usr/share/usermin/vendor_perl/Protocol/WebSocket

Name	Size	Mode	Actions
Cookie/	-	0755	rm
Handshake/	-	0755	rm
Client.pm	3607	0644	edit dl rm
Cookie.pm	1678	0644	edit dl rm
Frame.pm	11066	0644	edit dl rm
Handshake.pm	1121	0644	edit dl rm
Message.pm	4757	0644	edit dl rm
Request.pm	13256	0644	edit dl rm
Response.pm	8442	0644	edit dl rm
Stateful.pm	795	0644	edit dl rm
URL.pm	2154	0644	edit dl rm

Edit: /usr/share/usermin/vendor_perl/Protocol/WebSocket/Frame.pm (11066B)

package Protocol::WebSocket::Frame;

use strict;
use warnings;

use Config;
use Encode ();
use Scalar::Util 'readonly';

use constant MAX_RAND_INT       => 2**32;
use constant MATH_RANDOM_SECURE => eval "require Math::Random::Secure;";

our $MAX_PAYLOAD_SIZE = 65536;
our $MAX_FRAGMENTS_AMOUNT = 128;

our %TYPES = (
    continuation => 0x00,
    text         => 0x01,
    binary       => 0x02,
    ping         => 0x09,
    pong         => 0x0a,
    close        => 0x08
);

sub new {
    my $class = shift;
    $class = ref $class if ref $class;
    my $buffer;

if (@_ == 1) {
        $buffer = shift @_;
    }
    else {
        my %args = @_;
        $buffer = delete $args{buffer};
    }

my $self = {@_};
    bless $self, $class;

$buffer = '' unless defined $buffer;

if (Encode::is_utf8($buffer)) {
        $self->{buffer} = Encode::encode('UTF-8', $buffer);
    }
    else {
        $self->{buffer} = $buffer;
    }

if (defined($self->{type}) && defined($TYPES{$self->{type}})) {
        $self->opcode($TYPES{$self->{type}});
    }

$self->{version} ||= 'draft-ietf-hybi-17';

$self->{fragments} = [];

$self->{max_fragments_amount} ||= $MAX_FRAGMENTS_AMOUNT unless exists $self->{max_fragments_amount};
    $self->{max_payload_size}     ||= $MAX_PAYLOAD_SIZE unless exists $self->{max_payload_size};

return $self;
}

sub version {
    my $self = shift;

return $self->{version};
}

sub append {
    my $self = shift;

return unless defined $_[0];

$self->{buffer} .= $_[0];
    $_[0] = '' unless readonly $_[0];

return $self;
}

sub next {
    my $self = shift;

my $bytes = $self->next_bytes;
    return unless defined $bytes;

return Encode::decode('UTF-8', $bytes);
}

sub fin {
    @_ > 1 ? $_[0]->{fin} =
        $_[1]
      : defined($_[0]->{fin}) ? $_[0]->{fin}
      :                         1;
}
sub rsv { @_ > 1 ? $_[0]->{rsv} = $_[1] : $_[0]->{rsv} }

sub opcode {
    @_ > 1 ? $_[0]->{opcode} =
        $_[1]
      : defined($_[0]->{opcode}) ? $_[0]->{opcode}
      :                            1;
}
sub masked { @_ > 1 ? $_[0]->{masked} = $_[1] : $_[0]->{masked} }

sub is_ping         { $_[0]->opcode == 9 }
sub is_pong         { $_[0]->opcode == 10 }
sub is_close        { $_[0]->opcode == 8 }
sub is_continuation { $_[0]->opcode == 0 }
sub is_text         { $_[0]->opcode == 1 }
sub is_binary       { $_[0]->opcode == 2 }

sub next_bytes {
    my $self = shift;

if (   $self->version eq 'draft-hixie-75'
        || $self->version eq 'draft-ietf-hybi-00')
    {
        if ($self->{buffer} =~ s/^\xff\x00//) {
            $self->opcode(8);
            return '';
        }

return unless $self->{buffer} =~ s/^[^\x00]*\x00(.*?)\xff//s;

return $1;
    }

return unless length $self->{buffer} >= 2;

while (length $self->{buffer}) {
        my $hdr = substr($self->{buffer}, 0, 1);

my @bits = split //, unpack("B*", $hdr);

$self->fin($bits[0]);
        $self->rsv([@bits[1 .. 3]]);

my $opcode = unpack('C', $hdr) & 0b00001111;

my $offset = 1;    # FIN,RSV[1-3],OPCODE

my $payload_len = unpack 'C', substr($self->{buffer}, 1, 1);

my $masked = ($payload_len & 0b10000000) >> 7;
        $self->masked($masked);

$offset += 1;      # + MASKED,PAYLOAD_LEN

$payload_len = $payload_len & 0b01111111;
        if ($payload_len == 126) {
            return unless length($self->{buffer}) >= $offset + 2;

$payload_len = unpack 'n', substr($self->{buffer}, $offset, 2);

$offset += 2;
        }
        elsif ($payload_len > 126) {
            return unless length($self->{buffer}) >= $offset + 4;

my $bits = join '', map { unpack 'B*', $_ } split //,
              substr($self->{buffer}, $offset, 8);

# Most significant bit must be 0.
            # And here is a crazy way of doing it %)
            $bits =~ s{^.}{0};

# Can we handle 64bit numbers?
            if ($Config{ivsize} <= 4 || $Config{longsize} < 8 || $] < 5.010) {
                $bits = substr($bits, 32);
                $payload_len = unpack 'N', pack 'B*', $bits;
            }
            else {
                $payload_len = unpack 'Q>', pack 'B*', $bits;
            }

$offset += 8;
        }

if ($self->{max_payload_size} && $payload_len > $self->{max_payload_size}) {
            $self->{buffer} = '';
            die "Payload is too big. "
              . "Deny big message ($payload_len) "
              . "or increase max_payload_size ($self->{max_payload_size})";
        }

my $mask;
        if ($self->masked) {
            return unless length($self->{buffer}) >= $offset + 4;

$mask = substr($self->{buffer}, $offset, 4);
            $offset += 4;
        }

return if length($self->{buffer}) < $offset + $payload_len;

my $payload = substr($self->{buffer}, $offset, $payload_len);

if ($self->masked) {
            $payload = $self->_mask($payload, $mask);
        }

substr($self->{buffer}, 0, $offset + $payload_len, '');

# Injected control frame
        if (@{$self->{fragments}} && $opcode & 0b1000) {
            $self->opcode($opcode);
            return $payload;
        }

if ($self->fin) {
            if (@{$self->{fragments}}) {
                $self->opcode(shift @{$self->{fragments}});
            }
            else {
                $self->opcode($opcode);
            }
            $payload = join '', @{$self->{fragments}}, $payload;
            $self->{fragments} = [];
            return $payload;
        }
        else {

# Remember first fragment opcode
            if (!@{$self->{fragments}}) {
                push @{$self->{fragments}}, $opcode;
            }

push @{$self->{fragments}}, $payload;

die "Too many fragments"
              if @{$self->{fragments}} > $self->{max_fragments_amount};
        }
    }

return;
}

sub to_bytes {
    my $self = shift;

if (   $self->version eq 'draft-hixie-75'
        || $self->version eq 'draft-ietf-hybi-00')
    {
        if ($self->{type} && $self->{type} eq 'close') {
            return "\xff\x00";
        }

return "\x00" . $self->{buffer} . "\xff";
    }

if ($self->{max_payload_size} && length $self->{buffer} > $self->{max_payload_size}) {
        die "Payload is too big. "
          . "Send shorter messages or increase max_payload_size";
    }

my $rsv_set = 0;
    if ( $self->{rsv} && ref( $self->{rsv} ) eq 'ARRAY' ) {
        for my $i ( 0 .. @{ $self->{rsv} } - 1 ) {
            $rsv_set += $self->{rsv}->[$i] * ( 1 << ( 6 - $i ) );
        }
    }

my $string = '';
    my $opcode = $self->opcode;
    $string .= pack 'C', ($opcode | $rsv_set | ($self->fin ? 128 : 0));

my $payload_len = length($self->{buffer});
    if ($payload_len <= 125) {
        $payload_len |= 0b10000000 if $self->masked;
        $string .= pack 'C', $payload_len;
    }
    elsif ($payload_len <= 0xffff) {
        $string .= pack 'C', 126 + ($self->masked ? 128 : 0);
        $string .= pack 'n', $payload_len;
    }
    else {
        $string .= pack 'C', 127 + ($self->masked ? 128 : 0);

# Shifting by an amount >= to the system wordsize is undefined
        $string .= pack 'N', $Config{ivsize} <= 4 ? 0 : $payload_len >> 32;
        $string .= pack 'N', ($payload_len & 0xffffffff);
    }

if ($self->masked) {

my $mask = $self->{mask}
          || (
            MATH_RANDOM_SECURE
            ? Math::Random::Secure::irand(MAX_RAND_INT)
            : int(rand(MAX_RAND_INT))
          );

$mask = pack 'N', $mask;

$string .= $mask;
        $string .= $self->_mask($self->{buffer}, $mask);
    }
    else {
        $string .= $self->{buffer};
    }

return $string;
}

sub to_string {
    my $self = shift;

die 'DO NOT USE';
}

sub _mask {
    my $self = shift;
    my ($payload, $mask) = @_;

$mask = $mask x (int(length($payload) / 4) + 1);
    $mask = substr($mask, 0, length($payload));
    $payload = "$payload" ^ $mask;

return $payload;
}

sub max_payload_size {
    my $self = shift;

return $self->{max_payload_size};
}

1;
__END__

=head1 NAME

Protocol::WebSocket::Frame - WebSocket Frame

=head1 SYNOPSIS

# Create frame
    my $frame = Protocol::WebSocket::Frame->new('123');
    $frame->to_bytes;

# Parse frames
    my $frame = Protocol::WebSocket::Frame->new;
    $frame->append(...);
    $f->next; # get next message
    $f->next; # get another next message

=head1 DESCRIPTION

Construct or parse a WebSocket frame.

=head1 RANDOM MASK GENERATION

By default built-in C<rand> is used, this is not secure, so when
L<Math::Random::Secure> is installed it is used instead.

=head1 METHODS

=head2 C<new>

Protocol::WebSocket::Frame->new('data');   # same as (buffer => 'data')
    Protocol::WebSocket::Frame->new(buffer => 'data', type => 'close');

Create a new L<Protocol::WebSocket::Frame> instance. Automatically detect if the
passed data is a Perl string (UTF-8 flag) or bytes.

When called with more than one arguments, it takes the following named arguments
(all of them are optional).

=over

=item C<buffer> => STR (default: C<"">)

The payload of the frame.

=item C<type> => TYPE_STR (default: C<"text">)

The type of the frame. Accepted values are:

continuation
    text
    binary
    ping
    pong
    close

=item C<opcode> => INT (default: 1)

The opcode of the frame. If C<type> field is set to a valid string, this field is ignored.

=item C<fin> => BOOL (default: 1)

"fin" flag of the frame. "fin" flag must be 1 in the ending frame of fragments.

=item C<masked> => BOOL (default: 0)

If set to true, the frame will be masked.

=item C<version> => VERSION_STR (default: C<'draft-ietf-hybi-17'>)

WebSocket protocol version string. See L<Protocol::WebSocket> for valid version strings.

=back

=head2 C<is_continuation>

Check if frame is of continuation type.

=head2 C<is_text>

Check if frame is of text type.

=head2 C<is_binary>

Check if frame is of binary type.

=head2 C<is_ping>

Check if frame is a ping request.

=head2 C<is_pong>

Check if frame is a pong response.

=head2 C<is_close>

Check if frame is of close type.

=head2 C<opcode>

$opcode = $frame->opcode;
    $frame->opcode(8);

Get/set opcode of the frame.

=head2 C<masked>

$masked = $frame->masked;
    $frame->masked(1);

Get/set masking of the frame.

=head2 C<append>

$frame->append($chunk);

Append a frame chunk.

Beware that this method is B<destructive>.
It makes C<$chunk> empty unless C<$chunk> is read-only.

=head2 C<next>

$frame->append(...);

$frame->next; # next message

Return the next message as a Perl string (UTF-8 decoded).

=head2 C<next_bytes>

Return the next message as is.

=head2 C<to_bytes>

Construct a WebSocket message.

=head2 C<max_payload_size>

The maximum size of the payload. You may set this to C<0> or C<undef> to disable
checking the payload size.

=cut

cmd: