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 = '0.902'; # VERSION
  18
  19
  20 sub new {
  21     my $class = shift;
  22     my $self = bless {}, $class;
  23     $self->init(@_);
  24 }
  25
  26
  27 sub init {
  28     my $self = shift;
  29     my %args = @_;
  30
  31     @$self{keys %args} = values %args;
  32
  33     return $self;
  34 }
  35
  36 sub _rebless {
  37     my $self    = shift;
  38     my $format  = shift // $self->format;
  39
  40     my $sig2    = $self->kdbx->sig2;
  41     my $version = $self->kdbx->version;
  42
  43     my $subclass;
  44
  45     if (defined $format) {
  46         $subclass = $format;
  47     }
  48     elsif (defined $sig2 && $sig2 == KDBX_SIG2_1) {
  49         $subclass = 'KDB';
  50     }
  51     elsif (looks_like_number($version)) {
  52         my $major = $version & KDBX_VERSION_MAJOR_MASK;
  53         my %subclasses = (
  54             KDBX_VERSION_2_0() => 'V3',
  55             KDBX_VERSION_3_0() => 'V3',
  56             KDBX_VERSION_4_0() => 'V4',
  57         );
  58         $subclass = $subclasses{$major}
  59             or throw sprintf('Unsupported KDBX file version: %x', $version), version => $version;
  60     }
  61     else {
  62         throw sprintf('Unknown file version: %s', $version), version => $version;
  63     }
  64
  65     Module::Load::load "File::KDBX::Loader::$subclass";
  66     bless $self, "File::KDBX::Loader::$subclass";
  67 }
  68
  69
  70 sub reset {
  71     my $self = shift;
  72     %$self = ();
  73     return $self;
  74 }
  75
  76
  77 sub load {
  78     my $self = shift;
  79     my $src  = shift;
  80     return $self->load_handle($src, @_) if openhandle($src) || $src eq '-';
  81     return $self->load_string($src, @_) if is_scalarref($src);
  82     return $self->load_file($src, @_)   if !is_ref($src) && defined $src;
  83     throw 'Programmer error: Must pass a stringref, filepath or IO handle to read';
  84 }
  85
  86
  87 sub load_string {
  88     my $self = shift;
  89     my $str  = shift or throw 'Expected string to load';
  90     my %args = @_ % 2 == 0 ? @_ : (key => shift, @_);
  91
  92     my $key = delete $args{key};
  93     $args{kdbx} //= $self->kdbx;
  94
  95     my $ref = is_scalarref($str) ? $str : \$str;
  96
  97     open(my $fh, '<', $ref) or throw "Failed to open string buffer: $!";
  98
  99     $self = $self->new if !ref $self;
 100     $self->init(%args, fh => $fh)->_read($fh, $key);
 101     return $args{kdbx};
 102 }
 103
 104
 105 sub load_file {
 106     my $self     = shift;
 107     my $filepath = shift;
 108     my %args     = @_ % 2 == 0 ? @_ : (key => shift, @_);
 109
 110     my $key = delete $args{key};
 111     $args{kdbx} //= $self->kdbx;
 112
 113     open(my $fh, '<:raw', $filepath) or throw 'Open file failed', filepath => $filepath;
 114
 115     $self = $self->new if !ref $self;
 116     $self->init(%args, fh => $fh, filepath => $filepath)->_read($fh, $key);
 117     return $args{kdbx};
 118 }
 119
 120
 121 sub load_handle {
 122     my $self = shift;
 123     my $fh   = shift;
 124     my %args     = @_ % 2 == 0 ? @_ : (key => shift, @_);
 125
 126     $fh = *STDIN if $fh eq '-';
 127
 128     my $key = delete $args{key};
 129     $args{kdbx} //= $self->kdbx;
 130
 131     $self = $self->new if !ref $self;
 132     $self->init(%args, fh => $fh)->_read($fh, $key);
 133     return $args{kdbx};
 134 }
 135
 136
 137 sub kdbx {
 138     my $self = shift;
 139     return File::KDBX->new if !ref $self;
 140     $self->{kdbx} = shift if @_;
 141     $self->{kdbx} //= File::KDBX->new;
 142 }
 143
 144
 145 has format          => undef, is => 'ro';
 146 has inner_format    => 'XML', is => 'ro';
 147
 148
 149 sub read_magic_numbers {
 150     my $self = shift;
 151     my $fh   = shift;
 152     my $kdbx = shift // $self->kdbx;
 153
 154     read_all $fh, my $magic, 12 or throw 'Failed to read file signature';
 155
 156     my ($sig1, $sig2, $version) = unpack('L<3', $magic);
 157
 158     if ($kdbx) {
 159         $kdbx->sig1($sig1);
 160         $kdbx->sig2($sig2);
 161         $kdbx->version($version);
 162         $self->_rebless if ref $self;
 163     }
 164
 165     return wantarray ? ($sig1, $sig2, $version, $magic) : $magic;
 166 }
 167
 168 sub _fh { $_[0]->{fh} or throw 'IO handle not set' }
 169
 170 sub _read {
 171     my $self = shift;
 172     my $fh   = shift;
 173     my $key  = shift;
 174
 175     my $kdbx = $self->kdbx;
 176     $key //= $kdbx->key ? $kdbx->key->reload : undef;
 177     $kdbx->reset;
 178
 179     read_all $fh, my $buf, 1 or throw 'Failed to read the first byte', type => 'parser';
 180     my $first = ord($buf);
 181     $fh->ungetc($first);
 182     if ($first != KDBX_SIG1_FIRST_BYTE) {
 183         # not a KDBX file... try skipping the outer layer
 184         return $self->_read_inner_body($fh);
 185     }
 186
 187     my $magic = $self->read_magic_numbers($fh, $kdbx);
 188     $kdbx->sig1 == KDBX_SIG1 or throw 'Invalid file signature', type => 'parser', sig1 => $kdbx->sig1;
 189
 190     if (ref($self) =~ /::(?:KDB|V[34])$/) {
 191         defined $key or throw 'Must provide a master key', type => 'key.missing';
 192     }
 193
 194     my $headers = $self->_read_headers($fh);
 195
 196     eval {
 197         $self->_read_body($fh, $key, "$magic$headers");
 198     };
 199     if (my $err = $@) {
 200         throw "Failed to load KDBX file: $err",
 201             error               => $err,
 202             compression_error   => $IO::Uncompress::Gunzip::GunzipError,
 203             crypt_error         => $File::KDBX::IO::Crypt::ERROR,
 204             hash_error          => $File::KDBX::IO::HashBLock::ERROR,
 205             hmac_error          => $File::KDBX::IO::HmacBLock::ERROR;
 206     }
 207 }
 208
 209 sub _read_headers {
 210     my $self = shift;
 211     my $fh   = shift;
 212
 213     my $headers = $self->kdbx->headers;
 214     my $all_raw = '';
 215
 216     while (my ($type, $val, $raw) = $self->_read_header($fh)) {
 217         $all_raw .= $raw;
 218         last if $type == HEADER_END;
 219         $headers->{$type} = $val;
 220     }
 221
 222     return $all_raw;
 223 }
 224
 225 sub _read_body { die "Not implemented" }
 226
 227 sub _read_inner_body {
 228     my $self = shift;
 229
 230     my $current_pkg = ref $self;
 231     require Scope::Guard;
 232     my $guard = Scope::Guard->new(sub { bless $self, $current_pkg });
 233
 234     $self->_rebless($self->inner_format);
 235     $self->_read_inner_body(@_);
 236 }
 237
 238 1;
 239
 240 __END__
 241
 242 =pod
 243
 244 =encoding UTF-8
 245
 246 =head1 NAME
 247
 248 File::KDBX::Loader - Load KDBX files
 249
 250 =head1 VERSION
 251
 252 version 0.902
 253
 254 =head1 DESCRIPTION
 255
 256 =head1 ATTRIBUTES
 257
 258 =head2 kdbx
 259
 260     $kdbx = $loader->kdbx;
 261     $loader->kdbx($kdbx);
 262
 263 Get or set the L<File::KDBX> instance for storing the loaded data into.
 264
 265 =head2 format
 266
 267 Get the file format used for reading the database. Normally the format is auto-detected from the data stream.
 268 This auto-detection works well, so there's not really a good reason to explicitly specify the format.
 269 Possible formats:
 270
 271 =over 4
 272
 273 =item *
 274
 275 C<V3>
 276
 277 =item *
 278
 279 C<V4>
 280
 281 =item *
 282
 283 C<KDB>
 284
 285 =item *
 286
 287 C<XML>
 288
 289 =item *
 290
 291 C<Raw>
 292
 293 =back
 294
 295 =head2 inner_format
 296
 297 Get the format of the data inside the KDBX envelope. This only applies to C<V3> and C<V4> formats. Possible
 298 formats:
 299
 300 =over 4
 301
 302 =item *
 303
 304 C<XML> - Read the database groups and entries as XML (default)
 305
 306 =item *
 307
 308 C<Raw> - Read and store the result in L<File::KDBX/raw> without parsing
 309
 310 =back
 311
 312 =head1 METHODS
 313
 314 =head2 new
 315
 316     $loader = File::KDBX::Loader->new(%attributes);
 317
 318 Construct a new L<File::KDBX::Loader>.
 319
 320 =head2 init
 321
 322     $loader = $loader->init(%attributes);
 323
 324 Initialize a L<File::KDBX::Loader> with a new set of attributes.
 325
 326 This is called by L</new>.
 327
 328 =head2 reset
 329
 330     $loader = $loader->reset;
 331
 332 Set a L<File::KDBX::Loader> to a blank state, ready to load another KDBX file.
 333
 334 =head2 load
 335
 336     $kdbx = File::KDBX::Loader->load(\$string, %options);
 337     $kdbx = File::KDBX::Loader->load(\$string, $key);
 338     $kdbx = File::KDBX::Loader->load(*IO, %options);
 339     $kdbx = File::KDBX::Loader->load(*IO, $key);
 340     $kdbx = File::KDBX::Loader->load($filepath, %options);
 341     $kdbx = File::KDBX::Loader->load($filepath, $key);
 342
 343 Load a KDBX file. This works as an instance or a class method. The C<$key> is either
 344 a L<File::KDBX::Key> or a primitive castable to a Key object. Available options:
 345
 346 =over 4
 347
 348 =item *
 349
 350 C<key> - Alternative way to specify C<$key>
 351
 352 =back
 353
 354 =head2 load_string
 355
 356     $kdbx = File::KDBX::Loader->load_string($string, %options);
 357     $kdbx = File::KDBX::Loader->load_string($string, $key);
 358     $kdbx = File::KDBX::Loader->load_string(\$string, %options);
 359     $kdbx = File::KDBX::Loader->load_string(\$string, $key);
 360
 361 Load a KDBX file from a string / memory buffer. This works as an instance or class method. Available options:
 362
 363 =over 4
 364
 365 =item *
 366
 367 C<key> - Alternative way to specify C<$key>
 368
 369 =back
 370
 371 =head2 load_file
 372
 373     $kdbx = File::KDBX::Loader->load_file($filepath, %options);
 374     $kdbx = File::KDBX::Loader->load_file($filepath, $key);
 375
 376 Read a KDBX file from a filesystem. This works as an instance or class method. Available options:
 377
 378 =over 4
 379
 380 =item *
 381
 382 C<key> - Alternative way to specify C<$key>
 383
 384 =back
 385
 386 =head2 load_handle
 387
 388     $kdbx = File::KDBX::Loader->load_handle($fh, %options);
 389     $kdbx = File::KDBX::Loader->load_handle($fh, $key);
 390     $kdbx = File::KDBX::Loader->load_handle(*IO, %options);
 391     $kdbx = File::KDBX::Loader->load_handle(*IO, $key);
 392
 393 Read a KDBX file from an input stream / file handle. This works as an instance or class method. Available
 394 options:
 395
 396 =over 4
 397
 398 =item *
 399
 400 C<key> - Alternative way to specify C<$key>
 401
 402 =back
 403
 404 =head2 read_magic_numbers
 405
 406     $magic = File::KDBX::Loader->read_magic_numbers($fh);
 407     ($sig1, $sig2, $version, $magic) = File::KDBX::Loader->read_magic_numbers($fh);
 408
 409     $magic = $loader->read_magic_numbers($fh);
 410     ($sig1, $sig2, $version, $magic) = $loader->read_magic_numbers($fh);
 411
 412 Read exactly 12 bytes from an IO handle and parse them into the three magic numbers that begin
 413 a KDBX file. This is a quick way to determine if a file is actually a KDBX file.
 414
 415 C<$sig1> should always be C<KDBX_SIG1> if reading an actual KDB or KDBX file.
 416
 417 C<$sig2> should be C<KDBX_SIG2_1> for KeePass 1 files and C<KDBX_SIG2_2> for KeePass 2 files.
 418
 419 C<$version> is the file version (e.g. C<0x00040001>).
 420
 421 C<$magic> is the raw 12 bytes read from the IO handle.
 422
 423 If called on an instance, the C<sig1>, C<sig2> and C<version> attributes will be set in the L</kdbx>
 424 and the instance will be blessed into the correct loader subclass.
 425
 426 =head1 BUGS
 427
 428 Please report any bugs or feature requests on the bugtracker website
 429 L<https://github.com/chazmcgarvey/File-KDBX/issues>
 430
 431 When submitting a bug or request, please include a test-file or a
 432 patch to an existing test-file that illustrates the bug or desired
 433 feature.
 434
 435 =head1 AUTHOR
 436
 437 Charles McGarvey <ccm@cpan.org>
 438
 439 =head1 COPYRIGHT AND LICENSE
 440
 441 This software is copyright (c) 2022 by Charles McGarvey.
 442
 443 This is free software; you can redistribute it and/or modify it under
 444 the same terms as the Perl 5 programming language system itself.
 445
 446 =cut