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     my $got_iv_size = length($headers->{+HEADER_ENCRYPTION_IV});
  35     alert 'Encryption IV should be exactly 16 bytes long',
  36         got         => $got_iv_size,
  37         expected    => 16 if $got_iv_size != 16;
  38
  39     if (nonempty (my $comment = $headers->{+HEADER_COMMENT})) {
  40         $buf .= $self->_write_header($fh, HEADER_COMMENT, $comment);
  41     }
  42     for my $type (
  43         HEADER_CIPHER_ID,
  44         HEADER_COMPRESSION_FLAGS,
  45         HEADER_MASTER_SEED,
  46         HEADER_TRANSFORM_SEED,
  47         HEADER_TRANSFORM_ROUNDS,
  48         HEADER_ENCRYPTION_IV,
  49         HEADER_INNER_RANDOM_STREAM_KEY,
  50         HEADER_STREAM_START_BYTES,
  51         HEADER_INNER_RANDOM_STREAM_ID,
  52     ) {
  53         defined $headers->{$type} or throw "Missing value for required header: $type", type => $type;
  54         $buf .= $self->_write_header($fh, $type, $headers->{$type});
  55     }
  56     $buf .= $self->_write_header($fh, HEADER_END);
  57
  58     return $buf;
  59 }
  60
  61 sub _write_header {
  62     my $self = shift;
  63     my $fh   = shift;
  64     my $type = shift;
  65     my $val  = shift // '';
  66
  67     $type = to_header_constant($type);
  68     if ($type == HEADER_END) {
  69         $val = "\r\n\r\n";
  70     }
  71     elsif ($type == HEADER_COMMENT) {
  72         $val = encode('UTF-8', $val);
  73     }
  74     elsif ($type == HEADER_CIPHER_ID) {
  75         my $size = length($val);
  76         $size == 16 or throw 'Invalid cipher UUID length', got => $size, expected => $size;
  77     }
  78     elsif ($type == HEADER_COMPRESSION_FLAGS) {
  79         $val = pack('L<', $val);
  80     }
  81     elsif ($type == HEADER_MASTER_SEED) {
  82         my $size = length($val);
  83         $size == 32 or throw 'Invalid master seed length', got => $size, expected => $size;
  84     }
  85     elsif ($type == HEADER_TRANSFORM_SEED) {
  86         # nothing
  87     }
  88     elsif ($type == HEADER_TRANSFORM_ROUNDS) {
  89         $val = pack_Ql($val);
  90     }
  91     elsif ($type == HEADER_ENCRYPTION_IV) {
  92         # nothing
  93     }
  94     elsif ($type == HEADER_INNER_RANDOM_STREAM_KEY) {
  95         # nothing
  96     }
  97     elsif ($type == HEADER_STREAM_START_BYTES) {
  98         # nothing
  99     }
 100     elsif ($type == HEADER_INNER_RANDOM_STREAM_ID) {
 101         $val = pack('L<', $val);
 102     }
 103     elsif ($type == HEADER_KDF_PARAMETERS ||
 104            $type == HEADER_PUBLIC_CUSTOM_DATA) {
 105         throw "Unexpected KDBX4 header: $type", type => $type;
 106     }
 107     elsif ($type == HEADER_COMMENT) {
 108         throw "Unexpected KDB header: $type", type => $type;
 109     }
 110     else {
 111         alert "Unknown header: $type", type => $type;
 112     }
 113
 114     my $size = length($val);
 115     my $buf = pack('C S<', 0+$type, $size);
 116
 117     $fh->print($buf, $val) or throw 'Failed to write header';
 118
 119     return "$buf$val";
 120 }
 121
 122 sub _write_body {
 123     my $self = shift;
 124     my $fh   = shift;
 125     my $key  = shift;
 126     my $header_data = shift;
 127     my $kdbx = $self->kdbx;
 128
 129     # assert all required headers present
 130     for my $field (
 131         HEADER_CIPHER_ID,
 132         HEADER_ENCRYPTION_IV,
 133         HEADER_MASTER_SEED,
 134         HEADER_INNER_RANDOM_STREAM_KEY,
 135         HEADER_STREAM_START_BYTES,
 136     ) {
 137         defined $kdbx->headers->{$field} or throw "Missing $field";
 138     }
 139
 140     my $master_seed = $kdbx->headers->{+HEADER_MASTER_SEED};
 141
 142     my @cleanup;
 143     $key = $kdbx->composite_key($key);
 144
 145     my $response = $key->challenge($master_seed);
 146     push @cleanup, erase_scoped $response;
 147
 148     my $transformed_key = $kdbx->kdf->transform($key);
 149     push @cleanup, erase_scoped $transformed_key;
 150
 151     my $final_key = digest_data('SHA256', $master_seed, $response, $transformed_key);
 152     push @cleanup, erase_scoped $final_key;
 153
 154     my $cipher = $kdbx->cipher(key => $final_key);
 155     $fh = File::KDBX::IO::Crypt->new($fh, cipher => $cipher);
 156
 157     $fh->print($kdbx->headers->{+HEADER_STREAM_START_BYTES})
 158         or throw 'Failed to write start bytes';
 159
 160     $kdbx->key($key);
 161
 162     $fh = File::KDBX::IO::HashBlock->new($fh);
 163
 164     my $compress = $kdbx->headers->{+HEADER_COMPRESSION_FLAGS};
 165     if ($compress == COMPRESSION_GZIP) {
 166         load_optional('IO::Compress::Gzip');
 167         $fh = IO::Compress::Gzip->new($fh,
 168             -Level => IO::Compress::Gzip::Z_BEST_COMPRESSION(),
 169             -TextFlag => 1,
 170         ) or throw "Failed to initialize compression library: $IO::Compress::Gzip::GzipError",
 171             error => $IO::Compress::Gzip::GzipError;
 172     }
 173     elsif ($compress != COMPRESSION_NONE) {
 174         throw "Unsupported compression ($compress)\n", compression_flags => $compress;
 175     }
 176
 177     my $header_hash = digest_data('SHA256', $header_data);
 178     $self->_write_inner_body($fh, $header_hash);
 179 }
 180
 181 1;