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(:empty assert_64bit erase_scoped);
  14 use IO::Handle;
  15 use namespace::clean;
  16
  17 use parent '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 = KDBX_HEADER($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         assert_64bit;
  85         $val = pack('Q<', $val);
  86     }
  87     elsif ($type == HEADER_ENCRYPTION_IV) {
  88         # nothing
  89     }
  90     elsif ($type == HEADER_INNER_RANDOM_STREAM_KEY) {
  91         # nothing
  92     }
  93     elsif ($type == HEADER_STREAM_START_BYTES) {
  94         # nothing
  95     }
  96     elsif ($type == HEADER_INNER_RANDOM_STREAM_ID) {
  97         $val = pack('L<', $val);
  98     }
  99     elsif ($type == HEADER_KDF_PARAMETERS ||
 100            $type == HEADER_PUBLIC_CUSTOM_DATA) {
 101         throw "Unexpected KDBX4 header: $type", type => $type;
 102     }
 103     elsif ($type == HEADER_COMMENT) {
 104         throw "Unexpected KDB header: $type", type => $type;
 105     }
 106     else {
 107         alert "Unknown header: $type", type => $type;
 108     }
 109
 110     my $size = length($val);
 111     my $buf = pack('C S<', 0+$type, $size);
 112
 113     $fh->print($buf, $val) or throw 'Failed to write header';
 114
 115     return "$buf$val";
 116 }
 117
 118 sub _write_body {
 119     my $self = shift;
 120     my $fh   = shift;
 121     my $key  = shift;
 122     my $header_data = shift;
 123     my $kdbx = $self->kdbx;
 124
 125     # assert all required headers present
 126     for my $field (
 127         HEADER_CIPHER_ID,
 128         HEADER_ENCRYPTION_IV,
 129         HEADER_MASTER_SEED,
 130         HEADER_INNER_RANDOM_STREAM_KEY,
 131         HEADER_STREAM_START_BYTES,
 132     ) {
 133         defined $kdbx->headers->{$field} or throw "Missing $field";
 134     }
 135
 136     my $master_seed = $kdbx->headers->{+HEADER_MASTER_SEED};
 137
 138     my @cleanup;
 139     $key = $kdbx->composite_key($key);
 140
 141     my $response = $key->challenge($master_seed);
 142     push @cleanup, erase_scoped $response;
 143
 144     my $transformed_key = $kdbx->kdf->transform($key);
 145     push @cleanup, erase_scoped $transformed_key;
 146
 147     my $final_key = digest_data('SHA256', $master_seed, $response, $transformed_key);
 148     push @cleanup, erase_scoped $final_key;
 149
 150     my $cipher = $kdbx->cipher(key => $final_key);
 151     $fh = File::KDBX::IO::Crypt->new($fh, cipher => $cipher);
 152
 153     $fh->print($kdbx->headers->{+HEADER_STREAM_START_BYTES})
 154         or throw 'Failed to write start bytes';
 155     $fh->flush;
 156
 157     $kdbx->key($key);
 158
 159     $fh = File::KDBX::IO::HashBlock->new($fh);
 160
 161     my $compress = $kdbx->headers->{+HEADER_COMPRESSION_FLAGS};
 162     if ($compress == COMPRESSION_GZIP) {
 163         require IO::Compress::Gzip;
 164         $fh = IO::Compress::Gzip->new($fh,
 165             -Level => IO::Compress::Gzip::Z_BEST_COMPRESSION(),
 166             -TextFlag => 1,
 167         ) or throw "Failed to initialize compression library: $IO::Compress::Gzip::GzipError",
 168             error => $IO::Compress::Gzip::GzipError;
 169     }
 170     elsif ($compress != COMPRESSION_NONE) {
 171         throw "Unsupported compression ($compress)\n", compression_flags => $compress;
 172     }
 173
 174     my $header_hash = digest_data('SHA256', $header_data);
 175     $self->_write_inner_body($fh, $header_hash);
 176 }
 177
 178 1;