#! /usr/bin/perl -w

# Copyright 2017 John Hughes

# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:

# 1. Redistributions of source code must retain the above copyright notice,
# this list of conditions and the following disclaimer.

# 2. Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in the
# documentation and/or other materials provided with the distribution.

# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
# A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
# HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
# TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
# PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
# LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
# NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
# SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

use strict;

# Most clues from https://www.freedesktop.org/wiki/Software/systemd/journal-files/

# Read the header

use constant HEAD_LEN => 240;
use constant HEAD_DATA => 64;

my $head;

read (STDIN, $head, HEAD_LEN);

die "Missing header\n" if length $head != HEAD_LEN;

die "Not journal\n" unless substr ($head, 0, 8) eq "LPKSHHRH";

my $len = little (substr ($head, 88, 8)); # should check

seek STDIN, $len, 0;

my $pos = tell STDIN;

my %DATA;

while (my ($type, $flags, $len, $object) = read_object ()) {


	# Dumb way of detecting end, should use the "arena" info in
	# the file header

	last if $type == 0 && $len == 0;

	if ($type == 1) {
		# Need something to stop us reading huge binary objects
		# Need to handle compressed objects

		read STDIN, $object, ($len - length $object), length $object
			or die "Can't read DATA object\n";

		my $entries = little (substr $object, 56, 8);

		$DATA{$pos} = [ $entries, substr $object, 64 ];
	}
	elsif ($type == 3) {
		read STDIN, $object, ($len - length $object), length $object
			or die "Can't read ENTRY object\n";

		# 64 byte header, array of [offset, hash]

		# should print interesting info from header

		printf "%16x entry\n", $pos;

		for (my $i = 64; $i < length $object; $i += 16) {
			my $offset = little (substr ($object, $i, 8));

			# can do bunches of fun consistency checks
			# using hash fields

			if (my $data = $DATA{$offset}) {
				printf "\t%16x %s\n", $offset, $data->[1];
				delete $DATA{$offset} unless --$data->[0];
			}
			else {
				printf "\t%16x <missing>\n", $offset;
			}
		}
	}

	# Objects padded out to 8 bytes

	my $pad = $len % 8;

	$pad = 8 - $pad if $pad;

	$pos += $len + $pad;
	seek STDIN, $pos, 0;	# skip boring objects
}


sub read_object {
	my $object;

	read STDIN, $object, 16
		or return;

	my $type = ord $object;
	my $flags = ord substr $object, 1, 1;
	my $len = little (substr $object, 8, 8);

	return ($type, $flags, $len, $object);
}


sub little {
	my $bytes = shift;
	my $val = 0;
	my $mul = 1;

 	for (my $i = 0; $i < length $bytes; ++$i) {
		$val += ord (substr $bytes, $i) * $mul;
		$mul *= 256;
	}

	$val;
}
