<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package Apache::TrafficServer::BinLog;

use strict;
use warnings FATAL =&gt; 'all';

use Socket qw( :DEFAULT );

if ( ! defined( &amp;Socket::inet_ntop ) ) {
  eval "use Socket6;"; # For ye olde Peurle.
  die $@ if $@;
} else {
  Socket-&gt;import( qw( inet_ntop AF_INET6 AF_INET ) );
}

=head1 NAME

Apache::TrafficServer::BinLog - Log parsing for traffic server binary logfiles with direct timestamp seeking and fields manipulation.

=head1 VERSION

Version 0.01

=cut

our $VERSION = '0.01';

our $SZ_UINT                              = 4;
our $SZ_UINT64                            = 8;
our $LOG_SEGMENT_VERSION                  = 2;
our $IP_FAMILY_FIELD_LENGTH               = 2;
our $IPV4_FIELD_LENGTH                    = 4;
our $IPV6_FIELD_LENGTH                    = 16;
our $LOG_ENTRY_HEADER_LENGTH              = 1 * $SZ_UINT64 + 2 * $SZ_UINT;
our $LOG_BUFF_STATIC_HEADER_LENGTH        = 14 * $SZ_UINT + 1 * $SZ_UINT64;
our $INK_MIN_ALIGN                        = 8;
our $LOG_SEGMENT_COOKIE                   = 0xaceface;                        # proxy/logging/LogBuffer.h
our $LOG_BUFF_STATIC_HEADER_FORMAT        = 'L8 Q1 L6';
our $LOG_BUFF_DYNAMIC_HEADER_FORMAT       = 'Z* Z* Z* Z* Z*';
our $LOG_BUFF_STATIC_HEADER_COOKIE_FORMAT = 'L1';
our $LOG_BUFF_ENTRY_HEADER_FORMAT         = 'Q1 I1 I1';
our @LOG_BUFF_STATIC_HEADER_FIELDS        = qw/
  cookie version
  format_type byte_count entry_count low_timestamp high_timestamp log_object_flags
  log_object_signature
  fmt_name_offset fmt_fieldlist_offset fmt_printf_offset src_hostname_offset log_filename_offset data_offset/;
our @LOG_BUFF_DYNAMIC_HEADER_FIELDS        = qw/fmt_name_str fieldlist_str printf_str src_hostname_str log_filename_str/;

# proxy/logging/Log.cc
our %FIELD_TEMPLATE = ( cqtq              =&gt; 'L1',
                        ttms              =&gt; 'L1',
                        chi               =&gt; 'S1',
                        crc               =&gt; 'L1',
                        pssc              =&gt; 'L1',
                        psql              =&gt; 'L1',
                        cqhm              =&gt; 'Z*',
                        cquc              =&gt; 'Z*',
                        caun              =&gt; 'Z*',
                        phr               =&gt; 'L1',
                        pqsn              =&gt; 'Z*',
                        psct              =&gt; 'Z*',
                        xid               =&gt; 'Z*',
                        cquuc             =&gt; 'Z*',
                        '{User-Agent}cqh' =&gt; 'Z*', );

our %CRC_SYMBOL = ( '0' =&gt; 'EMPTY',
                    '1' =&gt; 'TCP_HIT',
                    '2' =&gt; 'TCP_DISK_HIT',
                    '.' =&gt; 'TCP_MEM_HIT',
                    '3' =&gt; 'TCP_MISS',
                    '4' =&gt; 'TCP_EXPIRED_MISS',
                    '5' =&gt; 'TCP_REFRESH_HIT',
                    '6' =&gt; 'TCP_REF_FAIL_HIT',
                    '7' =&gt; 'TCP_REFRESH_MISS',
                    '8' =&gt; 'TCP_CLIENT_REFRESH',
                    '9' =&gt; 'TCP_IMS_HIT',
                    'a' =&gt; 'TCP_IMS_MISS',
                    'b' =&gt; 'TCP_SWAPFAIL',
                    'c' =&gt; 'TCP_DENIED',
                    'd' =&gt; 'TCP_WEBFETCH_MISS',
                    'e' =&gt; 'TCP_SPIDER_BYPASS',
                    'f' =&gt; 'TCP_FUTURE_2',
                    '[' =&gt; 'TCP_HIT_REDIRECT',
                    ']' =&gt; 'TCP_MISS_REDIRECT',
                    '&lt;' =&gt; 'TCP_HIT_X_REDIRECT',
                    '&gt;' =&gt; 'TCP_MISS_X_REDIRECT',
                    'g' =&gt; 'UDP_HIT',
                    'h' =&gt; 'UDP_WEAK_HIT',
                    'i' =&gt; 'UDP_HIT_OBJ',
                    'j' =&gt; 'UDP_MISS',
                    'k' =&gt; 'UDP_DENIED',
                    'l' =&gt; 'UDP_INVALID',
                    'm' =&gt; 'UDP_RELOADING',
                    'n' =&gt; 'UDP_FUTURE_1',
                    'o' =&gt; 'UDP_FUTURE_2',
                    'p' =&gt; 'ERR_READ_TIMEOUT',
                    'q' =&gt; 'ERR_LIFETIME_EXP',
                    'r' =&gt; 'ERR_NO_CLIENTS_BIG_OBJ',
                    's' =&gt; 'ERR_READ_ERROR',
                    't' =&gt; 'ERR_CLIENT_ABORT',
                    'u' =&gt; 'ERR_CONNECT_FAIL',
                    'v' =&gt; 'ERR_INVALID_REQ',
                    'w' =&gt; 'ERR_UNSUP_REQ',
                    'x' =&gt; 'ERR_INVALID_URL',
                    'y' =&gt; 'ERR_NO_FDS',
                    'z' =&gt; 'ERR_DNS_FAIL',
                    'A' =&gt; 'ERR_NOT_IMPLEMENTED',
                    'B' =&gt; 'ERR_CANNOT_FETCH',
                    'C' =&gt; 'ERR_NO_RELAY',
                    'D' =&gt; 'ERR_DISK_IO',
                    'E' =&gt; 'ERR_ZERO_SIZE_OBJECT',
                    'G' =&gt; 'ERR_PROXY_DENIED',
                    'H' =&gt; 'ERR_WEBFETCH_DETECTED',
                    'I' =&gt; 'ERR_FUTURE_1',
                    'J' =&gt; 'ERR_SPIDER_MEMBER_ABORTED',
                    'K' =&gt; 'ERR_SPIDER_PARENTAL_CONTROL_RESTRICTION',
                    'L' =&gt; 'ERR_SPIDER_UNSUPPORTED_HTTP_VERSION',
                    'M' =&gt; 'ERR_SPIDER_UIF',
                    'N' =&gt; 'ERR_SPIDER_FUTURE_USE_1',
                    'O' =&gt; 'ERR_SPIDER_TIMEOUT_WHILE_PASSING',
                    'P' =&gt; 'ERR_SPIDER_TIMEOUT_WHILE_DRAINING',
                    'Q' =&gt; 'ERR_SPIDER_GENERAL_TIMEOUT',
                    'R' =&gt; 'ERR_SPIDER_CONNECT_FAILED',
                    'S' =&gt; 'ERR_SPIDER_FUTURE_USE_2',
                    'T' =&gt; 'ERR_SPIDER_NO_RESOURCES',
                    'U' =&gt; 'ERR_SPIDER_INTERNAL_ERROR',
                    'V' =&gt; 'ERR_SPIDER_INTERNAL_IO_ERROR',
                    'W' =&gt; 'ERR_SPIDER_DNS_TEMP_ERROR',
                    'X' =&gt; 'ERR_SPIDER_DNS_HOST_NOT_FOUND',
                    'Y' =&gt; 'ERR_SPIDER_DNS_NO_ADDRESS',
                    'Z' =&gt; 'ERR_UNKNOWN', );

# proxy/hdrs/HTTP.h
our %HIER_SYMBOL = ( 0 =&gt; 'EMPTY',
                     1 =&gt; 'NONE',
                     2 =&gt; 'DIRECT',
                     3 =&gt; 'SIBLING_HIT',
                     4 =&gt; 'PARENT_HIT',
                     5 =&gt; 'DEFAULT_PARENT',
                     6 =&gt; 'SINGLE_PARENT',
                     7 =&gt; 'FIRST_UP_PARENT',
                     8 =&gt; 'NO_PARENT_DIRECT',
                     9 =&gt; 'FIRST_PARENT_MISS',
                     a =&gt; 'LOCAL_IP_DIRECT',
                     b =&gt; 'FIREWALL_IP_DIRECT',
                     c =&gt; 'NO_DIRECT_FAIL',
                     d =&gt; 'SOURCE_FASTEST',
                     e =&gt; 'SIBLING_UDP_HIT_OBJ',
                     f =&gt; 'PARENT_UDP_HIT_OBJ',
                     g =&gt; 'PASSTHROUGH_PARENT',
                     h =&gt; 'SSL_PARENT_MISS',
                     i =&gt; 'INVALID_CODE',
                     j =&gt; 'TIMEOUT_DIRECT',
                     k =&gt; 'TIMEOUT_SIBLING_HIT',
                     l =&gt; 'TIMEOUT_PARENT_HIT',
                     m =&gt; 'TIMEOUT_DEFAULT_PARENT',
                     n =&gt; 'TIMEOUT_SINGLE_PARENT',
                     o =&gt; 'TIMEOUT_FIRST_UP_PARENT',
                     p =&gt; 'TIMEOUT_NO_PARENT_DIRECT',
                     q =&gt; 'TIMEOUT_FIRST_PARENT_MISS',
                     r =&gt; 'TIMEOUT_LOCAL_IP_DIRECT',
                     s =&gt; 'TIMEOUT_FIREWALL_IP_DIRECT',
                     t =&gt; 'TIMEOUT_NO_DIRECT_FAIL',
                     u =&gt; 'TIMEOUT_SOURCE_FASTEST',
                     v =&gt; 'TIMEOUT_SIBLING_UDP_HIT_OBJ',
                     w =&gt; 'TIMEOUT_PARENT_UDP_HIT_OBJ',
                     x =&gt; 'TIMEOUT_PASSTHROUGH_PARENT',
                     y =&gt; 'TIMEOUT_TIMEOUT_SSL_PARENT_MISS',
                     z =&gt; 'INVALID_ASSIGNED_CODE', );

# This is technically no longer needed since profiling showed that dynamically returning the anonymous subroutine is significantely slower than simply hardcoding the padding values in the _make_unpack_line() sub.
# It is left here as a matter of clarity of how each field is supposed to be padded.
our $FIELD_LENGTH_MAGIC = { 'cqtq'            =&gt; sub { return ( 0 ); },
                            'ttms'            =&gt; sub { return ( $INK_MIN_ALIGN ); },
                            'chi'             =&gt; sub { return ( $IP_FAMILY_FIELD_LENGTH + 2 ); },
                            'ipv4'            =&gt; sub { return ( $IPV4_FIELD_LENGTH ); },
                            'ipv6'            =&gt; sub { return ( $IPV6_FIELD_LENGTH + 4 ); },
                            'crc'             =&gt; sub { return ( $INK_MIN_ALIGN ); },
                            'pssc'            =&gt; sub { return ( $INK_MIN_ALIGN ); },
                            'psql'            =&gt; sub { return ( $INK_MIN_ALIGN ); },
                            'cqhm'            =&gt; sub { return ( _ink_align( length( $_[ 0 ] ) + 1, $INK_MIN_ALIGN ) ); },
                            'cquc'            =&gt; sub { return ( _ink_align( length( $_[ 0 ] ) + 1, $INK_MIN_ALIGN ) ); },
                            'caun'            =&gt; sub { return ( _ink_align( length( $_[ 0 ] ) + 1, $INK_MIN_ALIGN ) ); },
                            'phr'             =&gt; sub { return ( $INK_MIN_ALIGN ); },
                            'pqsn'            =&gt; sub { return ( _ink_align( length( $_[ 0 ] ) + 1, $INK_MIN_ALIGN ) ); },
                            'psct'            =&gt; sub { return ( _ink_align( length( $_[ 0 ] ) + 1, $INK_MIN_ALIGN ) ); },
                            'xid'             =&gt; sub { return ( _ink_align( length( $_[ 0 ] ) + 1, $INK_MIN_ALIGN ) ); },
                            'cquuc'           =&gt; sub { return ( _ink_align( length( $_[ 0 ] ) + 1, $INK_MIN_ALIGN ) ); },
                            '{User-Agent}cqh' =&gt; sub { return ( _ink_align( length( $_[ 0 ] ) + 1, $INK_MIN_ALIGN ) ); }, };


=head1 SYNOPSIS

    use Apache::TrafficServer::BinLog;

    my $binlog = Apache::TrafficServer::BinLog-&gt;new( { file =&gt; $path, tstamp =&gt; $tstamp } );
    my %line = $binlog-&gt;get_line();
    my @lines = $binlog-&gt;get_lines( 1000 );
    my $ascii_line = $binlog-&gt;get_line_ascii();
    my @ascii_lines = $binlog-&gt;get_lines_ascii( 1000 );

=head1 DESCRIPTION

This is an object-oriented library which will convert Apache Traffic Server binary logs from binary to ascii. It allows for direct seeking to a timestamp (or near a timestamp) that way one can only parse a "slice" of the log (say the last few seconds).
It can parse each log line into a hash table with each filed accessible as a key. It can also simply return the ascii line.
This module essentially does what logcat does but allows for horizontal and/or vertical slicing  of the logs using timestamps and/or fileds names.
Various methods can be called to extract 1 or more lines from the logfile. An internal pointer is always incremented each time one of the get_line[s] method is called.
The binary log format was mostly reverse engineered from the apache traffic server source code and thus could potentially be buggy. Also not all fields conversion is supposrted but enough of the basic ones are.

=head1 SUBROUTINES/METHODS

=head2 new

  my $binlog = Apache::TrafficServer::BinLog-&gt;new( { file =&gt; $path, tstamp =&gt; $tstamp } );

Instantiates an object which holds a logfile and a pointer to the current location inside the logfile.
The intenal pointer is defined by the 'tstamp' parameter.

=cut

sub new {
  my ( $class, %args ) = @_;

  my $self = bless( {}, $class );

  $self-&gt;{ 'cur_static_header' } = ();
  $self-&gt;{ 'cur_dynamic_header' } = ();
  $self-&gt;{ 'cur_lines' } = ();
  $self-&gt;{ 'error' } = "";

  if ( exists $args{ 'file' } ) {
    $self-&gt;{ 'file' } = $args{ 'file' };
    open ( $self-&gt;{ 'fh' }, "&lt;", $self-&gt;{ 'file' } ) or die "Can't open file $self-&gt;{ 'file' }\n";
  } else { die "need a file path"; }

  $self-&gt;{ 'line_format' } = $self-&gt;_get_bin_line_format();
  $self-&gt;{ 'reader_sub' } = *_get_next_log_buff{CODE};
  $self-&gt;{ 'cur_tstamp_pair_sub' } = *_get_cur_bin_tstamp_pair{CODE};
  $self-&gt;{ 'unpack_line_sub' } = eval $self-&gt;_make_unpack_line( 'PERL', @{ $self-&gt;{ 'line_format' } } );
  $self-&gt;{ 'unpack_ascii_line_sub' } = eval $self-&gt;_make_unpack_line( 'ASCII', @{ $self-&gt;{ 'line_format' } } );
  $self-&gt;_read_headers( 1 ) or die "Can't init parser because $self-&gt;{ 'error' }.";

  unless ( $self-&gt;{ 'tstamp' } ) {
    $self-&gt;{ 'tstamp' } = $self-&gt;{ 'cur_static_header' }-&gt;{ 'low_timestamp' };
  }

  if ( exists $args{ 'tstamp' } ) {
    $self-&gt;set_tstamp( $args{ 'tstamp' } );
  }

  if ( exists $args{ 'length' } ) {
    $self-&gt;set_length( $args{ 'length' } );
  }

  return $self;
}

=head2 set_tstamp 

  $binlog-&gt;set_tstamp( $tstamp );

Seeks to the timestamp specified. (or very close to it :) )

=cut

sub set_tstamp {
  my ( $self, $tstamp ) = @_;

  $self-&gt;{ 'tstamp' } = $tstamp;
  unless ( $self-&gt;_seek_to_tstamp( $self-&gt;{ 'tstamp' }, 0, -s $self-&gt;{ 'file' }, $self-&gt;{ 'fh' } ) ) {
    die $self-&gt;{'error'};
  }
}

=head2 set_length

  $binlog-&gt;set_length( $length );

Sets the length (in seconds) of the slice we wnat from the log file.

=cut

sub set_length {
  my ( $self, $length ) = @_;

  $self-&gt;{ 'length' } = $length;
}

=head2 get_last_tstamp 

  my $tstamp = $binlog-&gt;get_last_tstamp();

Gets last timestamp in the file. (uesful for tailing last few seconds of log) 

=cut

sub get_last_tstamp {
  my ( $self ) = @_;

  return $self-&gt;_get_last_bin_tstamp();
}

=head2 get_line 

  my $line_hash_ref = $binlog-&gt;get_line();

Gets one line of the logfile with each elements of the line neatly parsed into a hashref.

=cut

sub get_line {
  my ( $self ) = @_;

  my $line;
  unless ( $line = shift ( @{ $self-&gt;{ 'cur_lines' } } ) ) {
    unless ( $self-&gt;{ 'reader_sub' }-&gt;( $self, 'PERL' ) ) {
      return 0;
    }
    $line = shift ( @{ $self-&gt;{ 'cur_lines' } } )
  } 
  return $line;
}

=head2 get_ascii_line 

  my $line = $binlog-&gt;get_ascii_line();

Gets one line of the logfile in ascii.

=cut

sub get_ascii_line {
  my ( $self ) = @_;

  my $line;
  unless ( $line = shift ( @{ $self-&gt;{ 'cur_lines' } } ) ) {
    unless ( $self-&gt;{ 'reader_sub' }-&gt;( $self, 'ASCII' ) ) {
      return 0;
    }
    $line = shift ( @{ $self-&gt;{ 'cur_lines' } } )
  }
  return $line;
}

=head2 get_lines 

  my $lines_array_ref = $binlog-&gt;get_lines( $num );

Get $num lines from the logfiles and returns them into an arrayref of hashref.

=cut

sub get_lines {
  my ( $self, $num ) = @_;

  my @lines;

  while ( @lines &lt; $num ) {
    if ( $self-&gt;{ 'cur_lines' } ) {
      push( @lines, @{ $self-&gt;{ 'cur_lines' } } );
      delete( $self-&gt;{ 'cur_lines' } );
    } else {
      unless ( $self-&gt;{ 'reader_sub' }-&gt;( $self, 'PERL' ) ) { 
        if ( @lines ) { return \@lines }
        else { return 0; }
      }
    }
  }
  return \@lines;
}

=head2 get_ascii_lines 

  my $lines_array_ref = $binlog-&gt;get_ascii_lines( $num );

Get $num lines from the logfiles and returns them in ascii in an arrayref.

=cut

sub get_ascii_lines {
  my ( $self, $num ) = @_;

  my @lines;

  while ( @lines &lt; $num ) {
    if ( $self-&gt;{ 'cur_lines' } ) {
      push( @lines, @{ $self-&gt;{ 'cur_lines' } } );
      delete( $self-&gt;{ 'cur_lines' } );
    } else {
      unless ( $self-&gt;{ 'reader_sub' }-&gt;( $self, 'ASCII' ) ) { 
        if ( @lines ) { return \@lines }
        else { return 0; }
      }
    }
  }
  return \@lines;
}

=head2 get_line_fields 

  my $format_array_ref = $binlog-&gt;get_line_fields();

Returns the line log format of the file as an array ref.

=cut

sub get_line_fields {
  my ( $self ) = @_;

  # This looks silly now, but this sub used to support UFF and [AY]TS format and thus was an encapsulation of several pivate "get_format" methods.
  return $self-&gt;_get_bin_line_format();
}


### "Private" methods ###

# Extract the log line format stored in the LogBuffer dynamic header.
# Logging fields are defined in the ATS docs here:
# http://trafficserver.apache.org/docs/trunk/admin/event-logging-formats/index.en.html
sub _get_bin_line_format {
  my ( $self ) = @_;

  my @line_format;

  if ( $self-&gt;{ 'cur_dynamic_header' } ) {
    @line_format = split( /,/, $self-&gt;{ 'cur_dynamic_header' }-&gt;{ 'fieldlist_str' } );
  } else {
    $self-&gt;_read_headers( 1 ); 
    @line_format = split( /,/, $self-&gt;{ 'cur_dynamic_header' }-&gt;{ 'fieldlist_str' } );
  }
  return \@line_format;
}

# Attempts to retrieve the last low_timestamp and high_timestamp pair from the last LogBuffer in the file.
# Walks the file backwards 64 bytes at a time from the end of the file.
sub _get_last_bin_tstamp {
  my ( $self ) = @_;

  my $seek_pos = $LOG_BUFF_STATIC_HEADER_LENGTH;
  my $cur_pos = seek( $self-&gt;{ 'fh' }, -$seek_pos, 2 ) or die "can't seek";
  
  while( !$self-&gt;_align_to_cookie() ) {
    $seek_pos += $LOG_BUFF_STATIC_HEADER_LENGTH;
    if ( $seek_pos &gt;= -s $self-&gt;{ 'file' } ) { return 0; }
    $cur_pos = seek( $self-&gt;{ 'fh' }, -$seek_pos, 2 ) or die "can't seek";
  }
  my %tstamps = $self-&gt;{ 'cur_tstamp_pair_sub' }-&gt;( $self );
  return $tstamps{ 'high' };
}

# Gets the next LogBuffer which will contains several lines of the log.
sub _get_next_log_buff {
  my ( $self, $output_type ) = @_;

  my @lines;
  my $log_buff_data;

  unless ( $self-&gt;_read_headers( 0 ) ) {
    $self-&gt;{ 'error' } .= "Can't read headers";
    return 0;
  } 

  if ( $self-&gt;{ 'length' } ) {
    if ( $self-&gt;{ 'cur_static_header' }-&gt;{ 'low_timestamp' } &gt;= $self-&gt;{ 'tstamp' } + $self-&gt;{ 'length' } ) {
      return 0;
    }
  }

  # the log buffer size minus the size of the static header since we already read it.
  my $log_buff_data_length = $self-&gt;{ 'cur_static_header' }-&gt;{ 'byte_count' } - $self-&gt;{ 'cur_static_header' }-&gt;{ 'data_offset' };
  my $cur_log_buff_entry   = 0;

  # reading one log buffer which will contain the dynamic header and several log entries which contains several log fields.
  unless ( seek( $self-&gt;{ 'fh' }, $self-&gt;{ 'cur_static_header' }-&gt;{ 'data_offset' }, 1 ) ) {
    $self-&gt;{ 'error' } .= "Can't seek to $self-&gt;{ 'cur_static_header' }-&gt;{ 'data_offset' }.";
    return 0;
  }
  unless ( read( $self-&gt;{ 'fh' }, $log_buff_data, $log_buff_data_length ) ) {
    $self-&gt;{ 'error' } .= "Can't read file at ". seek( $self-&gt;{'fh'}, 0, 1) . ".";
    return 0;
  }

  LOGENTRY: while ( $cur_log_buff_entry != $log_buff_data_length ) {
    my %line = ();
    my $line = "";

    #### PARSE OF ENTRY HEADER ####
    my %log_buff_entry_header;
    @log_buff_entry_header{ qw/timestamp timestamp_usec entry_len/ } = unpack $LOG_BUFF_ENTRY_HEADER_FORMAT, substr( $log_buff_data, $cur_log_buff_entry, $LOG_ENTRY_HEADER_LENGTH );
    $log_buff_entry_header{ 'timestamp_usec' } = sprintf( "%03s", int( $log_buff_entry_header{ 'timestamp_usec' } / 1000 ) );

    #### PARSE OF ENTRY DATA ####
    my $log_buff_entry_data = substr( $log_buff_data, $cur_log_buff_entry + $LOG_ENTRY_HEADER_LENGTH, $log_buff_entry_header{ 'entry_len' } );
    my $cur_log_buff_entry_field = $INK_MIN_ALIGN;
    if ( $output_type eq 'ASCII' ) {
      $line .= $log_buff_entry_header{ 'timestamp' } . "." . $log_buff_entry_header{ 'timestamp_usec' };
      if ( $self-&gt;{ 'unpack_ascii_line_sub' }-&gt;( \$log_buff_entry_data, \$cur_log_buff_entry_field, \$line ) ) {
        push( @lines, $line );
      } #something bad happened if we don't get here.
    } else {
      $line{ 'cqtq' } = sprintf( "%.3f", $log_buff_entry_header{ 'timestamp' } . "." . $log_buff_entry_header{ 'timestamp_usec' } );
      if ( $self-&gt;{ 'unpack_line_sub' }-&gt;( \$log_buff_entry_data, \$cur_log_buff_entry_field, \%line ) ) {
        if ( scalar ( @{ $self-&gt;{ 'line_format' } } ) == scalar ( keys ( %line ) ) ) {
          push( @lines, \%line ); #if we don't get here, line split wrong. ignore. likely data corruption in file.
        }
      } #something bad happened if we don't get here.
    }
    $cur_log_buff_entry += $log_buff_entry_header{ 'entry_len' };
  }
  $self-&gt;{ 'cur_lines' } = \@lines;
  return 1;
}

# This sub only reads the static and optionally the dynamic header without touching the field data. 
# Seeks back to begining of log buffer at the end.
sub _read_headers {
  my ( $self, $dynamic ) = @_;

  my ( $buff, $offset );

  unless ( $self-&gt;_align_to_cookie() ) {
    $self-&gt;{ 'error' } .= "Can't align to cookie or EOF.\n";
    return 0;
  }
  read( $self-&gt;{ 'fh' }, $buff, $LOG_BUFF_STATIC_HEADER_LENGTH );
  @{ $self-&gt;{ 'cur_static_header' } }{ @LOG_BUFF_STATIC_HEADER_FIELDS } = unpack $LOG_BUFF_STATIC_HEADER_FORMAT, $buff;
  if ( $self-&gt;{ 'cur_static_header' }-&gt;{ 'version' } != $LOG_SEGMENT_VERSION ) { 
    $self-&gt;{ 'error' } .= "Can't parse version $self-&gt;{ 'cur_static_header' }-&gt;{ 'version' }.\n";
    return 0;
  }
  $offset = $LOG_BUFF_STATIC_HEADER_LENGTH;
  if ( $dynamic ) {
    read( $self-&gt;{ 'fh' }, $buff, $self-&gt;{ 'cur_static_header' }-&gt;{ 'data_offset' } - $self-&gt;{ 'cur_static_header' }-&gt;{ 'fmt_name_offset' } );
    @{ $self-&gt;{ 'cur_dynamic_header' } }{ @LOG_BUFF_DYNAMIC_HEADER_FIELDS } = unpack $LOG_BUFF_DYNAMIC_HEADER_FORMAT, $buff;
    $offset = $self-&gt;{ 'cur_static_header' }-&gt;{ 'data_offset' };
  }
  seek( $self-&gt;{ 'fh' }, -$offset, 1 );

  return 1;
}

# The following 2 subs used to borrow code from "AnyEvents::Sockets" to provide ipv6 parsing for perl &lt; 5.12. 
# Due to possible license concerns it now uses the low level core Socket module.
sub _format_ipv4 {
  my ( $ipv4 ) = @_;

  return inet_ntop( AF_INET, $ipv4 );
}

sub _format_ipv6 {
  my ( $ipv6 ) = @_;

  return inet_ntop( AF_INET6, $ipv6 );
}

# _ink_align() is only to be used to align on a power of 2 boundary
sub _ink_align {
    my ( $size, $boundary ) = @_;
    return ( ( ( $size ) + ( ( $boundary ) - 1 ) ) &amp; ~( ( $boundary ) - 1 ) );
}

# Align the filehandle pointer to the begining of a LogBuffer ( starts with 0xACEFACE )
sub _align_to_cookie {
  my ( $self ) = @_;

  my $rv = read( $self-&gt;{ 'fh' }, my $buff, $LOG_BUFF_STATIC_HEADER_LENGTH );
  if ( $rv &lt; $LOG_BUFF_STATIC_HEADER_LENGTH ) { return 0; } # EOF
  my $cookie = unpack $LOG_BUFF_STATIC_HEADER_COOKIE_FORMAT, substr( $buff, 0, $SZ_UINT );
  while ( $cookie != $LOG_SEGMENT_COOKIE ) {
    $buff = substr( $buff, 1 );
    if ( read( $self-&gt;{ 'fh' }, my $byte, 1 ) ) {
      $buff .= $byte;
      $cookie = unpack $LOG_BUFF_STATIC_HEADER_COOKIE_FORMAT, substr( $buff, 0, $SZ_UINT );
    } else { return 0; }
  }
  seek( $self-&gt;{ 'fh' }, -$LOG_BUFF_STATIC_HEADER_LENGTH, 1 );
  return 1;
}

# We only aligns with the begining of a LogBuffer which contains several Log entries. 
# Therefore we may not align exactly to the time stamp provided. 
# We will always align like so: low_timestamp &lt; $tstamp &lt; high_timestamp
# This sub is just a recursive binary search :)
sub _seek_to_tstamp {
  my ( $self, $tstamp, $logfile_min, $logfile_max ) = @_;

  unless ( defined( $logfile_min ) &amp;&amp; defined( $logfile_max ) ) {
    $logfile_min = 0; 
    $logfile_max = -s $self-&gt;{ 'file' };
  }

  if ( $logfile_max &lt; $logfile_min ) { 
    $self-&gt;{ 'error' } .= "Can't seek to time stamp $tstamp.\n";
    return 0; 
  } else {
    my $logfile_mid = int( $logfile_min + ( ( $logfile_max - $logfile_min ) / 2 ) );
    unless ( $self-&gt;_seek_to_byte( $logfile_mid ) ) {
      $self-&gt;{ 'error' } .= "Can't seek to byte $logfile_mid.\n";
      return 0;
    }
    my %cur_tstamp = $self-&gt;{ 'cur_tstamp_pair_sub' }-&gt;( $self );
    if ( %cur_tstamp ) {
      if ( $cur_tstamp{ 'low' } &gt; $tstamp ) {
        return $self-&gt;_seek_to_tstamp( $tstamp, $logfile_min, ( $logfile_mid - 1 ) );
      } elsif ( $cur_tstamp{ 'high' } &lt; $tstamp ) {
        return $self-&gt;_seek_to_tstamp( $tstamp, $logfile_mid + ( 1, $logfile_max ) );
      } else {
        seek( $self-&gt;{ 'fh' }, -$LOG_BUFF_STATIC_HEADER_LENGTH, 1 );
        return seek( $self-&gt;{ 'fh' }, 0, 1 );
      }
    } else {
      $self-&gt;{ 'error' } .= "Can't seek to time stamp $tstamp.\n";
      return 0;
    }
  }
}

# Seeks to $byte in the file. :)
sub _seek_to_byte {
  my ( $self, $byte ) = @_;
  if ( seek( $self-&gt;{ 'fh' }, $byte, 0 ) ) {
    return 1;
  } else { return 0; }
}


# Extract low_timestamp and high_timestamp from the static LogBuffer header.
sub _get_cur_bin_tstamp_pair {
  my ( $self ) = @_;

  my %tstamps = ();

  my ( $buff, $rv );

  unless ( $self-&gt;_read_headers( 0 ) ) { 
    $self-&gt;{ 'error' } .= "Can't read headers.\n";
    return 0; 
  };

  $tstamps{ 'low' }  = $self-&gt;{ 'cur_static_header' }-&gt;{ 'low_timestamp' };
  $tstamps{ 'high' } = $self-&gt;{ 'cur_static_header' }-&gt;{ 'high_timestamp' };

  return %tstamps;
}

# Dynamically generate the code that will unpack a given LogEntry for any given log line format.
sub _make_unpack_line {
  my ( $self, $output_type, @line_format ) = @_;

  my $dyna_code =     'sub {' . "\n"
                     .'  my ( $log_buff_entry_data, $cur_log_buff_entry_field, $line ) = @_;' . "\n"
                     .'  my $field;' . "\n";
  foreach my $field_name ( @line_format ) {
    next if ( $field_name eq 'cqtq' || $field_name eq 'cqts');
    if ( $field_name eq 'chi' ) {
      $dyna_code .=   '  $field = unpack( "' . $FIELD_TEMPLATE{ 'chi' } . '", substr( $$log_buff_entry_data, $$cur_log_buff_entry_field ) );' . "\n"
                     .'  $$cur_log_buff_entry_field += ' . ( $IP_FAMILY_FIELD_LENGTH + 2 ) . ';' . "\n"
                     .'  if ( $field == AF_INET ) {' . "\n";
      if ( $output_type eq 'ASCII' ) {
        $dyna_code .= '    $$line .= " " . _format_ipv4( substr( $$log_buff_entry_data, $$cur_log_buff_entry_field, ' . $IPV4_FIELD_LENGTH . ' ) );' . "\n";
      } else {
        $dyna_code .= '    $line-&gt;{ "chi" } = _format_ipv4( substr( $$log_buff_entry_data, $$cur_log_buff_entry_field, ' . $IPV4_FIELD_LENGTH . ' ) );' . "\n";
      }
      $dyna_code .=   '    $$cur_log_buff_entry_field += ' . $IPV4_FIELD_LENGTH . ';' . "\n"
                     .'  } elsif ( $field == AF_INET6 ) {' . "\n";
      if ( $output_type eq 'ASCII' ) {
        $dyna_code .= '    $$line .= " " . _format_ipv6( substr( $$log_buff_entry_data, $$cur_log_buff_entry_field, ' . $IPV6_FIELD_LENGTH . ' ) );' . "\n";
      } else {
        $dyna_code .= '    $line-&gt;{ "chi" } = _format_ipv6( substr( $$log_buff_entry_data, $$cur_log_buff_entry_field, ' . $IPV6_FIELD_LENGTH . ' ) );' . "\n";
      }
      $dyna_code .=   '    $$cur_log_buff_entry_field += ' . ( $IPV6_FIELD_LENGTH + 4 ) . ';' . "\n"
                     .'  } else {' . "\n"
                     .'    return 0;' . "\n"
                     .'  }' . "\n";
    } elsif ( $field_name eq 'crc' ) {
      $dyna_code .=   '  $field = unpack( "' . $FIELD_TEMPLATE{ 'crc' } . '", substr( $$log_buff_entry_data, $$cur_log_buff_entry_field ) );' . "\n"
                     .'  if ( defined $CRC_SYMBOL{ chr( $field ) } ) {' . "\n";
      if ( $output_type eq 'ASCII' ) {
        $dyna_code .= '    $$line .= " " . $CRC_SYMBOL{ chr( $field ) };' . "\n";
      } else {
        $dyna_code .= '    $line-&gt;{ "crc" } = $CRC_SYMBOL{ chr( $field ) };' . "\n";
      }
      $dyna_code .=   '    $$cur_log_buff_entry_field += ' . $INK_MIN_ALIGN . ';' . "\n"
                     .'  } else {' . "\n"
                     .'    return 0;' . "\n"
                     .'  }' . "\n";
    } elsif ( $field_name eq 'phr' ) {
      $dyna_code .=   '  $field = unpack( "' . $FIELD_TEMPLATE{ 'phr' } . '", substr( $$log_buff_entry_data, $$cur_log_buff_entry_field ) );' . "\n"
                     .'  if ( defined $HIER_SYMBOL{ chr( $field ) } ) {' . "\n";
      if ( $output_type eq 'ASCII' ) {
        $dyna_code .= '    $$line .= " " . $HIER_SYMBOL{ chr( $field ) };' . "\n";
      } else {
        $dyna_code .= '    $line-&gt;{ "phr" } = $HIER_SYMBOL{ chr( $field ) };' . "\n";
      }
      $dyna_code .=   '  } else {' . "\n";
      if ( $output_type eq 'ASCII' ) {
        $dyna_code .= '    $$line .= " " . "INVALID";' . "\n";
      } else {
        $dyna_code .= '    $line-&gt;{ "phr" } = "INVALID";' . "\n";
      }
      $dyna_code .=   '  }' . "\n"
                     .'  $$cur_log_buff_entry_field += ' . $INK_MIN_ALIGN . ';' . "\n";
    } elsif ( $field_name eq '{User-Agent}cqh' ) {
      $dyna_code .=   '  $field = unpack( "' . $FIELD_TEMPLATE{ '{User-Agent}cqh' } . '", substr( $$log_buff_entry_data, $$cur_log_buff_entry_field ) );' . "\n";
      if ( $output_type eq 'ASCII' ) {
        $dyna_code .= '  $$line .= " \"" . $field . "\"";' . "\n";
      } else {
        $dyna_code .= '  $line-&gt;{ "{User-Agent}cqh" } = $field;' . "\n";
      }
      $dyna_code .=   '  $$cur_log_buff_entry_field += _ink_align( length( $field ) + 1, $INK_MIN_ALIGN );' . "\n";
    } elsif ( $field_name eq 'ttms' || $field_name eq 'pssc' || $field_name eq 'psql' ) {
      $dyna_code .=   '  $field = unpack( "' . $FIELD_TEMPLATE{ $field_name  } . '", substr( $$log_buff_entry_data, $$cur_log_buff_entry_field ) );' . "\n";
      if ( $output_type eq 'ASCII' ) {
        $dyna_code .= '  $$line .= " " . $field;' . "\n";
      } else {
        $dyna_code .= '  $line-&gt;{ "' . $field_name . '" } = $field;' . "\n";
      }
      $dyna_code .=   '  $$cur_log_buff_entry_field += ' . $INK_MIN_ALIGN . ';' . "\n";
    } else {
      $dyna_code .=   '  $field = unpack( "' . $FIELD_TEMPLATE{ $field_name  } . '", substr( $$log_buff_entry_data, $$cur_log_buff_entry_field ) );' . "\n";
      if ( $output_type eq 'ASCII' ) {
        $dyna_code .= '  $$line .= " " . $field;' . "\n";
      } else {
        $dyna_code .= '  $line-&gt;{ "' . $field_name . '" } = $field;' . "\n";
      }
      $dyna_code .=   '  $$cur_log_buff_entry_field += _ink_align( length( $field ) + 1, $INK_MIN_ALIGN );' . "\n";
    }
  }
  $dyna_code .=       'return 1;' . "\n"
                     .'};' . "\n";
  return $dyna_code;
}

=head1 AUTHOR

Stephane Bagneris, C&lt;&lt; &lt;sbagneri at yahoo-inc.com&gt; &gt;&gt;

=head1 BUGS

Please report any bugs or feature requests to C&lt;bug-apache-trafficserver-binlog at rt.cpan.org&gt;, or through
the web interface at L&lt;http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Apache-TrafficServer-BinLog&gt;.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.




=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Apache::TrafficServer::BinLog


You can also look for information at:

=over 4

=item * RT: CPAN's request tracker (report bugs here)

L&lt;http://rt.cpan.org/NoAuth/Bugs.html?Dist=Apache-TrafficServer-BinLog&gt;

=item * AnnoCPAN: Annotated CPAN documentation

L&lt;http://annocpan.org/dist/Apache-TrafficServer-BinLog&gt;

=item * CPAN Ratings

L&lt;http://cpanratings.perl.org/d/Apache-TrafficServer-BinLog&gt;

=item * Search CPAN

L&lt;http://search.cpan.org/dist/Apache-TrafficServer-BinLog/&gt;

=back


=head1 ACKNOWLEDGEMENTS


=head1 LICENSE AND COPYRIGHT

Copyright 2013 Yahoo! inc..

Licensed under the Perl License.;

=cut

1; # End of Apache::TrafficServer::BinLog
</pre></body></html>