Dogcows Code - chaz/p5-File-KDBX/blob - lib/File/KDBX/Dumper/V3.pm

   1 package File::KDBX::Dumper::V3;
   2 # ABSTRACT: Dump KDBX3 files
   3
   4 use warnings;
   5 use strict;
   6
   7 use Crypt::Digest qw(digest_data);
   8 use Encode qw(encode);
   9 use File::KDBX::Constants qw(:header :compression);
  10 use File::KDBX::Error;
  11 use File::KDBX::IO::Crypt;
  12 use File::KDBX::IO::HashBlock;
  13 use File::KDBX::Util qw(:class :empty :int :load erase_scoped);
  14 use IO::Handle;
  15 use namespace::clean;
  16
  17 extends 'File::KDBX::Dumper';
  18
  19 our $VERSION = '999.999'; # VERSION
  20
  21 sub _write_headers {
  22     my $self = shift;
  23     my $fh = shift;
  24
  25     my $kdbx = $self->kdbx;
  26     my $headers = $kdbx->headers;
  27     my $buf = '';
  28
  29     # FIXME kinda janky - maybe add a "prepare" hook to massage the KDBX into the correct shape before we get
  30     # this far
  31     local $headers->{+HEADER_TRANSFORM_SEED} = $kdbx->transform_seed;
  32     local $headers->{+HEADER_TRANSFORM_ROUNDS} = $kdbx->transform_rounds;
  33
  34     if (nonempty (my $comment = $headers->{+HEADER_COMMENT})) {
  35         $buf .= $self->_write_header($fh, HEADER_COMMENT, $comment);
  36     }
  37     for my $type (
  38         HEADER_CIPHER_ID,
  39         HEADER_COMPRESSION_FLAGS,
  40         HEADER_MASTER_SEED,
  41         HEADER_TRANSFORM_SEED,
  42         HEADER_TRANSFORM_ROUNDS,
  43         HEADER_ENCRYPTION_IV,
  44         HEADER_INNER_RANDOM_STREAM_KEY,
  45         HEADER_STREAM_START_BYTES,
  46         HEADER_INNER_RANDOM_STREAM_ID,
  47     ) {
  48         defined $headers->{$type} or throw "Missing value for required header: $type", type => $type;
  49         $buf .= $self->_write_header($fh, $type, $headers->{$type});
  50     }
  51     $buf .= $self->_write_header($fh, HEADER_END);
  52
  53     return $buf;
  54 }
  55
  56 sub _write_header {
  57     my $self = shift;
  58     my $fh   = shift;
  59     my $type = shift;
  60     my $val  = shift // '';
  61
  62     $type = to_header_constant($type);
  63     if ($type == HEADER_END) {
  64         $val = "\r\n\r\n";
  65     }
  66     elsif ($type == HEADER_COMMENT) {
  67         $val = encode('UTF-8', $val);
  68     }
  69     elsif ($type == HEADER_CIPHER_ID) {
  70         my $size = length($val);
  71         $size == 16 or throw 'Invalid cipher UUID length', got => $size, expected => $size;
  72     }
  73     elsif ($type == HEADER_COMPRESSION_FLAGS) {
  74         $val = pack('L<', $val);
  75     }
  76     elsif ($type == HEADER_MASTER_SEED) {
  77         my $size = length($val);
  78         $size == 32 or throw 'Invalid master seed length', got => $size, expected => $size;
  79     }
  80     elsif ($type == HEADER_TRANSFORM_SEED) {
  81         # nothing
  82     }
  83     elsif ($type == HEADER_TRANSFORM_ROUNDS) {
  84         $val = pack_Ql($val);
  85     }
  86     elsif ($type == HEADER_ENCRYPTION_IV) {
  87         # nothing
  88     }
  89     elsif ($type == HEADER_INNER_RANDOM_STREAM_KEY) {
  90         # nothing
  91     }
  92     elsif ($type == HEADER_STREAM_START_BYTES) {
  93         # nothing
  94     }
  95     elsif ($type == HEADER_INNER_RANDOM_STREAM_ID) {
  96         $val = pack('L<', $val);
  97     }
  98     elsif ($type == HEADER_KDF_PARAMETERS ||
  99            $type == HEADER_PUBLIC_CUSTOM_DATA) {
 100         throw "Unexpected KDBX4 header: $type", type => $type;
 101     }
 102     elsif ($type == HEADER_COMMENT) {
 103         throw "Unexpected KDB header: $type", type => $type;
 104     }
 105     else {
 106         alert "Unknown header: $type", type => $type;
 107     }
 108
 109     my $size = length($val);
 110     my $buf = pack('C S<', 0+$type, $size);
 111
 112     $fh->print($buf, $val) or throw 'Failed to write header';
 113
 114     return "$buf$val";
 115 }
 116
 117 sub _write_body {
 118     my $self = shift;
 119     my $fh   = shift;
 120     my $key  = shift;
 121     my $header_data = shift;
 122     my $kdbx = $self->kdbx;
 123
 124     # assert all required headers present
 125     for my $field (
 126         HEADER_CIPHER_ID,
 127         HEADER_ENCRYPTION_IV,
 128         HEADER_MASTER_SEED,
 129         HEADER_INNER_RANDOM_STREAM_KEY,
 130         HEADER_STREAM_START_BYTES,
 131     ) {
 132         defined $kdbx->headers->{$field} or throw "Missing $field";
 133     }
 134
 135     my $master_seed = $kdbx->headers->{+HEADER_MASTER_SEED};
 136
 137     my @cleanup;
 138     $key = $kdbx->composite_key($key);
 139
 140     my $response = $key->challenge($master_seed);
 141     push @cleanup, erase_scoped $response;
 142
 143     my $transformed_key = $kdbx->kdf->transform($key);
 144     push @cleanup, erase_scoped $transformed_key;
 145
 146     my $final_key = digest_data('SHA256', $master_seed, $response, $transformed_key);
 147     push @cleanup, erase_scoped $final_key;
 148
 149     my $cipher = $kdbx->cipher(key => $final_key);
 150     $fh = File::KDBX::IO::Crypt->new($fh, cipher => $cipher);
 151
 152     $fh->print($kdbx->headers->{+HEADER_STREAM_START_BYTES})
 153         or throw 'Failed to write start bytes';
 154
 155     $kdbx->key($key);
 156
 157     $fh = File::KDBX::IO::HashBlock->new($fh);
 158
 159     my $compress = $kdbx->headers->{+HEADER_COMPRESSION_FLAGS};
 160     if ($compress == COMPRESSION_GZIP) {
 161         load_optional('IO::Compress::Gzip');
 162         $fh = IO::Compress::Gzip->new($fh,
 163             -Level => IO::Compress::Gzip::Z_BEST_COMPRESSION(),
 164             -TextFlag => 1,
 165         ) or throw "Failed to initialize compression library: $IO::Compress::Gzip::GzipError",
 166             error => $IO::Compress::Gzip::GzipError;
 167     }
 168     elsif ($compress != COMPRESSION_NONE) {
 169         throw "Unsupported compression ($compress)\n", compression_flags => $compress;
 170     }
 171
 172     my $header_hash = digest_data('SHA256', $header_data);
 173     $self->_write_inner_body($fh, $header_hash);
 174 }
 175
 176 1;