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

   1 package File::KDBX::Loader;
   2 # ABSTRACT: Load KDBX files
   3
   4 use warnings;
   5 use strict;
   6
   7 use File::KDBX::Constants qw(:magic :header :version);
   8 use File::KDBX::Error;
   9 use File::KDBX::Util qw(:class :io);
  10 use File::KDBX;
  11 use IO::Handle;
  12 use Module::Load ();
  13 use Ref::Util qw(is_ref is_scalarref);
  14 use Scalar::Util qw(looks_like_number openhandle);
  15 use namespace::clean;
  16
  17 our $VERSION = '999.999'; # VERSION
  18
  19 =method new
  20
  21     $loader = File::KDBX::Loader->new(%attributes);
  22
  23 Construct a new L<File::KDBX::Loader>.
  24
  25 =cut
  26
  27 sub new {
  28     my $class = shift;
  29     my $self = bless {}, $class;
  30     $self->init(@_);
  31 }
  32
  33 =method init
  34
  35     $loader = $loader->init(%attributes);
  36
  37 Initialize a L<File::KDBX::Loader> with a new set of attributes.
  38
  39 This is called by L</new>.
  40
  41 =cut
  42
  43 sub init {
  44     my $self = shift;
  45     my %args = @_;
  46
  47     @$self{keys %args} = values %args;
  48
  49     return $self;
  50 }
  51
  52 sub _rebless {
  53     my $self    = shift;
  54     my $format  = shift // $self->format;
  55
  56     my $sig2    = $self->kdbx->sig2;
  57     my $version = $self->kdbx->version;
  58
  59     my $subclass;
  60
  61     if (defined $format) {
  62         $subclass = $format;
  63     }
  64     elsif (defined $sig2 && $sig2 == KDBX_SIG2_1) {
  65         $subclass = 'KDB';
  66     }
  67     elsif (looks_like_number($version)) {
  68         my $major = $version & KDBX_VERSION_MAJOR_MASK;
  69         my %subclasses = (
  70             KDBX_VERSION_2_0() => 'V3',
  71             KDBX_VERSION_3_0() => 'V3',
  72             KDBX_VERSION_4_0() => 'V4',
  73         );
  74         $subclass = $subclasses{$major}
  75             or throw sprintf('Unsupported KDBX file version: %x', $version), version => $version;
  76     }
  77     else {
  78         throw sprintf('Unknown file version: %s', $version), version => $version;
  79     }
  80
  81     Module::Load::load "File::KDBX::Loader::$subclass";
  82     bless $self, "File::KDBX::Loader::$subclass";
  83 }
  84
  85 =method reset
  86
  87     $loader = $loader->reset;
  88
  89 Set a L<File::KDBX::Loader> to a blank state, ready to load another KDBX file.
  90
  91 =cut
  92
  93 sub reset {
  94     my $self = shift;
  95     %$self = ();
  96     return $self;
  97 }
  98
  99 =method load
 100
 101     $kdbx = File::KDBX::Loader->load(\$string, %options);
 102     $kdbx = File::KDBX::Loader->load(\$string, $key);
 103     $kdbx = File::KDBX::Loader->load(*IO, %options);
 104     $kdbx = File::KDBX::Loader->load(*IO, $key);
 105     $kdbx = File::KDBX::Loader->load($filepath, %options);
 106     $kdbx = File::KDBX::Loader->load($filepath, $key);
 107
 108 Load a KDBX file. This works as an instance or a class method. The C<$key> is either
 109 a L<File::KDBX::Key> or a primitive castable to a Key object. Available options:
 110
 111 =for :list
 112 * C<key> - Alternative way to specify C<$key>
 113
 114 =cut
 115
 116 sub load {
 117     my $self = shift;
 118     my $src  = shift;
 119     return $self->load_handle($src, @_) if openhandle($src) || $src eq '-';
 120     return $self->load_string($src, @_) if is_scalarref($src);
 121     return $self->load_file($src, @_)   if !is_ref($src) && defined $src;
 122     throw 'Programmer error: Must pass a stringref, filepath or IO handle to read';
 123 }
 124
 125 =method load_string
 126
 127     $kdbx = File::KDBX::Loader->load_string($string, %options);
 128     $kdbx = File::KDBX::Loader->load_string($string, $key);
 129     $kdbx = File::KDBX::Loader->load_string(\$string, %options);
 130     $kdbx = File::KDBX::Loader->load_string(\$string, $key);
 131
 132 Load a KDBX file from a string / memory buffer. This works as an instance or class method. Available options:
 133
 134 =for :list
 135 * C<key> - Alternative way to specify C<$key>
 136
 137 =cut
 138
 139 sub load_string {
 140     my $self = shift;
 141     my $str  = shift or throw 'Expected string to load';
 142     my %args = @_ % 2 == 0 ? @_ : (key => shift, @_);
 143
 144     my $key = delete $args{key};
 145     $args{kdbx} //= $self->kdbx;
 146
 147     my $ref = is_scalarref($str) ? $str : \$str;
 148
 149     open(my $fh, '<', $ref) or throw "Failed to open string buffer: $!";
 150
 151     $self = $self->new if !ref $self;
 152     $self->init(%args, fh => $fh)->_read($fh, $key);
 153     return $args{kdbx};
 154 }
 155
 156 =method load_file
 157
 158     $kdbx = File::KDBX::Loader->load_file($filepath, %options);
 159     $kdbx = File::KDBX::Loader->load_file($filepath, $key);
 160
 161 Read a KDBX file from a filesystem. This works as an instance or class method. Available options:
 162
 163 =for :list
 164 * C<key> - Alternative way to specify C<$key>
 165
 166 =cut
 167
 168 sub load_file {
 169     my $self     = shift;
 170     my $filepath = shift;
 171     my %args     = @_ % 2 == 0 ? @_ : (key => shift, @_);
 172
 173     my $key = delete $args{key};
 174     $args{kdbx} //= $self->kdbx;
 175
 176     open(my $fh, '<:raw', $filepath) or throw 'Open file failed', filepath => $filepath;
 177
 178     $self = $self->new if !ref $self;
 179     $self->init(%args, fh => $fh, filepath => $filepath)->_read($fh, $key);
 180     return $args{kdbx};
 181 }
 182
 183 =method load_handle
 184
 185     $kdbx = File::KDBX::Loader->load_handle($fh, %options);
 186     $kdbx = File::KDBX::Loader->load_handle($fh, $key);
 187     $kdbx = File::KDBX::Loader->load_handle(*IO, %options);
 188     $kdbx = File::KDBX::Loader->load_handle(*IO, $key);
 189
 190 Read a KDBX file from an input stream / file handle. This works as an instance or class method. Available
 191 options:
 192
 193 =for :list
 194 * C<key> - Alternative way to specify C<$key>
 195
 196 =cut
 197
 198 sub load_handle {
 199     my $self = shift;
 200     my $fh   = shift;
 201     my %args     = @_ % 2 == 0 ? @_ : (key => shift, @_);
 202
 203     $fh = *STDIN if $fh eq '-';
 204
 205     my $key = delete $args{key};
 206     $args{kdbx} //= $self->kdbx;
 207
 208     $self = $self->new if !ref $self;
 209     $self->init(%args, fh => $fh)->_read($fh, $key);
 210     return $args{kdbx};
 211 }
 212
 213 =attr kdbx
 214
 215     $kdbx = $loader->kdbx;
 216     $loader->kdbx($kdbx);
 217
 218 Get or set the L<File::KDBX> instance for storing the loaded data into.
 219
 220 =cut
 221
 222 sub kdbx {
 223     my $self = shift;
 224     return File::KDBX->new if !ref $self;
 225     $self->{kdbx} = shift if @_;
 226     $self->{kdbx} //= File::KDBX->new;
 227 }
 228
 229 =attr format
 230
 231 Get the file format used for reading the database. Normally the format is auto-detected from the data stream.
 232 This auto-detection works well, so there's not really a good reason to explicitly specify the format.
 233 Possible formats:
 234
 235 =for :list
 236 * C<V3>
 237 * C<V4>
 238 * C<KDB>
 239 * C<XML>
 240 * C<Raw>
 241
 242 =attr inner_format
 243
 244 Get the format of the data inside the KDBX envelope. This only applies to C<V3> and C<V4> formats. Possible
 245 formats:
 246
 247 =for :list
 248 * C<XML> - Read the database groups and entries as XML (default)
 249 * C<Raw> - Read and store the result in L<File::KDBX/raw> without parsing
 250
 251 =cut
 252
 253 has format          => undef, is => 'ro';
 254 has inner_format    => 'XML', is => 'ro';
 255
 256 =method read_magic_numbers
 257
 258     $magic = File::KDBX::Loader->read_magic_numbers($fh);
 259     ($sig1, $sig2, $version, $magic) = File::KDBX::Loader->read_magic_numbers($fh);
 260
 261     $magic = $loader->read_magic_numbers($fh);
 262     ($sig1, $sig2, $version, $magic) = $loader->read_magic_numbers($fh);
 263
 264 Read exactly 12 bytes from an IO handle and parse them into the three magic numbers that begin
 265 a KDBX file. This is a quick way to determine if a file is actually a KDBX file.
 266
 267 C<$sig1> should always be C<KDBX_SIG1> if reading an actual KDB or KDBX file.
 268
 269 C<$sig2> should be C<KDBX_SIG2_1> for KeePass 1 files and C<KDBX_SIG2_2> for KeePass 2 files.
 270
 271 C<$version> is the file version (e.g. C<0x00040001>).
 272
 273 C<$magic> is the raw 12 bytes read from the IO handle.
 274
 275 If called on an instance, the C<sig1>, C<sig2> and C<version> attributes will be set in the L</kdbx>
 276 and the instance will be blessed into the correct loader subclass.
 277
 278 =cut
 279
 280 sub read_magic_numbers {
 281     my $self = shift;
 282     my $fh   = shift;
 283     my $kdbx = shift // $self->kdbx;
 284
 285     read_all $fh, my $magic, 12 or throw 'Failed to read file signature';
 286
 287     my ($sig1, $sig2, $version) = unpack('L<3', $magic);
 288
 289     if ($kdbx) {
 290         $kdbx->sig1($sig1);
 291         $kdbx->sig2($sig2);
 292         $kdbx->version($version);
 293         $self->_rebless if ref $self;
 294     }
 295
 296     return wantarray ? ($sig1, $sig2, $version, $magic) : $magic;
 297 }
 298
 299 sub _fh { $_[0]->{fh} or throw 'IO handle not set' }
 300
 301 sub _read {
 302     my $self = shift;
 303     my $fh   = shift;
 304     my $key  = shift;
 305
 306     my $kdbx = $self->kdbx;
 307     $key //= $kdbx->key ? $kdbx->key->reload : undef;
 308     $kdbx->reset;
 309
 310     read_all $fh, my $buf, 1 or throw 'Failed to read the first byte', type => 'parser';
 311     my $first = ord($buf);
 312     $fh->ungetc($first);
 313     if ($first != KDBX_SIG1_FIRST_BYTE) {
 314         # not a KDBX file... try skipping the outer layer
 315         return $self->_read_inner_body($fh);
 316     }
 317
 318     my $magic = $self->read_magic_numbers($fh, $kdbx);
 319     $kdbx->sig1 == KDBX_SIG1 or throw 'Invalid file signature', type => 'parser', sig1 => $kdbx->sig1;
 320
 321     if (ref($self) =~ /::(?:KDB|V[34])$/) {
 322         defined $key or throw 'Must provide a master key', type => 'key.missing';
 323     }
 324
 325     my $headers = $self->_read_headers($fh);
 326
 327     eval {
 328         $self->_read_body($fh, $key, "$magic$headers");
 329     };
 330     if (my $err = $@) {
 331         throw "Failed to load KDBX file: $err",
 332             error               => $err,
 333             compression_error   => $IO::Uncompress::Gunzip::GunzipError,
 334             crypt_error         => $File::KDBX::IO::Crypt::ERROR,
 335             hash_error          => $File::KDBX::IO::HashBLock::ERROR,
 336             hmac_error          => $File::KDBX::IO::HmacBLock::ERROR;
 337     }
 338 }
 339
 340 sub _read_headers {
 341     my $self = shift;
 342     my $fh   = shift;
 343
 344     my $headers = $self->kdbx->headers;
 345     my $all_raw = '';
 346
 347     while (my ($type, $val, $raw) = $self->_read_header($fh)) {
 348         $all_raw .= $raw;
 349         last if $type == HEADER_END;
 350         $headers->{$type} = $val;
 351     }
 352
 353     return $all_raw;
 354 }
 355
 356 sub _read_body { die "Not implemented" }
 357
 358 sub _read_inner_body {
 359     my $self = shift;
 360
 361     my $current_pkg = ref $self;
 362     require Scope::Guard;
 363     my $guard = Scope::Guard->new(sub { bless $self, $current_pkg });
 364
 365     $self->_rebless($self->inner_format);
 366     $self->_read_inner_body(@_);
 367 }
 368
 369 1;
 370 __END__
 371
 372 =head1 DESCRIPTION
 373
 374
 375 =cut