util/perl/TLSProxy/NewSessionTicket.pm

   1 # Copyright 2016-2024 The OpenSSL Project Authors. All Rights Reserved.
   2 #
   3 # Licensed under the Apache License 2.0 (the "License").  You may not use
   4 # this file except in compliance with the License.  You can obtain a copy
   5 # in the file LICENSE in the source distribution or at
   6 # https://www.openssl.org/source/license.html
   7
   8 use strict;
   9
  10 package TLSProxy::NewSessionTicket;
  11
  12 use vars '@ISA';
  13 push @ISA, 'TLSProxy::Message';
  14
  15 sub new_dtls
  16 {
  17     my $class = shift;
  18
  19     my ($server,
  20         $msgseq,
  21         $msgfrag,
  22         $msgfragoffs,
  23         $data,
  24         $records,
  25         $startoffset,
  26         $message_frag_lens) = @_;
  27
  28     return $class->init(
  29         1,
  30         $server,
  31         $msgseq,
  32         $msgfrag,
  33         $msgfragoffs,
  34         $data,
  35         $records,
  36         $startoffset,
  37         $message_frag_lens
  38     )
  39 }
  40
  41 sub new
  42 {
  43     my $class = shift;
  44
  45     my ($server,
  46         $data,
  47         $records,
  48         $startoffset,
  49         $message_frag_lens) = @_;
  50
  51     return $class->init(
  52         0,
  53         $server,
  54         0, # msgseq
  55         0, # msgfrag
  56         0, # $msgfragoffs
  57         $data,
  58         $records,
  59         $startoffset,
  60         $message_frag_lens
  61     )
  62 }
  63
  64 sub init{
  65     my $class = shift;
  66     my ($isdtls,
  67         $server,
  68         $msgseq,
  69         $msgfrag,
  70         $msgfragoffs,
  71         $data,
  72         $records,
  73         $startoffset,
  74         $message_frag_lens) = @_;
  75
  76     my $self = $class->SUPER::new(
  77         $isdtls,
  78         $server,
  79         TLSProxy::Message::MT_NEW_SESSION_TICKET,
  80         $msgseq,
  81         $msgfrag,
  82         $msgfragoffs,
  83         $data,
  84         $records,
  85         $startoffset,
  86         $message_frag_lens);
  87
  88     $self->{ticket_lifetime_hint} = 0;
  89     $self->{ticket} = "";
  90
  91     return $self;
  92 }
  93
  94 sub parse
  95 {
  96     my $self = shift;
  97
  98     my $ticket_lifetime_hint = unpack('N', $self->data);
  99     my $ticket_len = unpack('n', $self->data);
 100     my $ticket = substr($self->data, 6, $ticket_len);
 101
 102     $self->ticket_lifetime_hint($ticket_lifetime_hint);
 103     $self->ticket($ticket);
 104 }
 105
 106
 107 #Reconstruct the on-the-wire message data following changes
 108 sub set_message_contents
 109 {
 110     my $self = shift;
 111     my $data;
 112
 113     $data = pack('N', $self->ticket_lifetime_hint);
 114     $data .= pack('n', length($self->ticket));
 115     $data .= $self->ticket;
 116
 117     $self->data($data);
 118 }
 119
 120 #Read/write accessors
 121 sub ticket_lifetime_hint
 122 {
 123     my $self = shift;
 124     if (@_) {
 125       $self->{ticket_lifetime_hint} = shift;
 126     }
 127     return $self->{ticket_lifetime_hint};
 128 }
 129 sub ticket
 130 {
 131     my $self = shift;
 132     if (@_) {
 133       $self->{ticket} = shift;
 134     }
 135     return $self->{ticket};
 136 }
 137 1;