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

   1 package File::KDBX::Entry;
   2 # ABSTRACT: A KDBX database entry
   3
   4 use warnings;
   5 use strict;
   6
   7 use Crypt::Misc 0.049 qw(decode_b64 encode_b32r);
   8 use Devel::GlobalDestruction;
   9 use Encode qw(encode);
  10 use File::KDBX::Constants qw(:history :icon);
  11 use File::KDBX::Error;
  12 use File::KDBX::Util qw(:assert :class :coercion :erase :function :uri generate_uuid load_optional);
  13 use Hash::Util::FieldHash;
  14 use List::Util qw(any first sum0);
  15 use Ref::Util qw(is_coderef is_hashref is_plain_hashref);
  16 use Scalar::Util qw(blessed looks_like_number);
  17 use Storable qw(dclone);
  18 use Time::Piece 1.33;
  19 use boolean;
  20 use namespace::clean;
  21
  22 extends 'File::KDBX::Object';
  23
  24 our $VERSION = '999.999'; # VERSION
  25
  26 my $PLACEHOLDER_MAX_DEPTH = 10;
  27 my %PLACEHOLDERS;
  28 my %STANDARD_STRINGS = map { $_ => 1 } qw(Title UserName Password URL Notes);
  29
  30 =attr foreground_color
  31
  32 Text color represented as a string of the form C<#000000>.
  33
  34 =attr background_color
  35
  36 Background color represented as a string of the form C<#FFFFFF>.
  37
  38 =attr override_url
  39
  40 TODO
  41
  42 =attr auto_type_enabled
  43
  44 Whether or not the entry is eligible to be matched for auto-typing.
  45
  46 =attr auto_type_obfuscation
  47
  48 Whether or not to use some kind of obfuscation when sending keystroke sequences to applications.
  49
  50 =attr auto_type_default_sequence
  51
  52 The default auto-type keystroke sequence.
  53
  54 =attr auto_type_associations
  55
  56 An array of window title / keystroke sequence associations.
  57
  58     {
  59         window              => 'Example Window Title',
  60         keystroke_sequence  => '{USERNAME}{TAB}{PASSWORD}{ENTER}',
  61     }
  62
  63 Keystroke sequences can have L</Placeholders>, most commonly C<{USERNAME}> and C<{PASSWORD}>.
  64
  65 =attr quality_check
  66
  67 Boolean indicating whether the entry password should be tested for weakness and show up in reports.
  68
  69 =attr strings
  70
  71 Hash with entry strings, including the standard strings as well as any custom ones.
  72
  73     {
  74         # Every entry has these five strings:
  75         Title    => { value => 'Example Entry' },
  76         UserName => { value => 'jdoe' },
  77         Password => { value => 's3cr3t', protect => true },
  78         URL      => { value => 'https://example.com' }
  79         Notes    => { value => '' },
  80         # May also have custom strings:
  81         MySystem => { value => 'The mainframe' },
  82     }
  83
  84 There are methods available to provide more convenient access to strings, including L</string>,
  85 L</string_value>, L</expand_string_value> and L</string_peek>.
  86
  87 =attr binaries
  88
  89 Files or attachments. Binaries are similar to strings except they have a value of bytes instead of test
  90 characters.
  91
  92     {
  93         'myfile.txt'    => {
  94             value   => '...',
  95         },
  96         'mysecrets.txt' => {
  97             value   => '...',
  98             protect => true,
  99         },
 100     }
 101
 102 There are methods available to provide more convenient access to binaries, including L</binary> and
 103 L</binary_value>.
 104
 105 =attr history
 106
 107 Array of historical entries. Historical entries are prior versions of the same entry so they all share the
 108 same UUID with the current entry.
 109
 110 =attr notes
 111
 112 Alias for the B<Notes> string value.
 113
 114 =attr password
 115
 116 Alias for the B<Password> string value.
 117
 118 =attr title
 119
 120 Alias for the B<Title> string value.
 121
 122 =attr url
 123
 124 Alias for the B<URL> string value.
 125
 126 =attr username
 127
 128 Aliases for the B<UserName> string value.
 129
 130 =cut
 131
 132 sub uuid {
 133     my $self = shift;
 134     if (@_ || !defined $self->{uuid}) {
 135         my %args = @_ % 2 == 1 ? (uuid => shift, @_) : @_;
 136         my $old_uuid = $self->{uuid};
 137         my $uuid = $self->{uuid} = delete $args{uuid} // generate_uuid;
 138         for my $entry (@{$self->history}) {
 139             $entry->{uuid} = $uuid;
 140         }
 141         $self->_signal('uuid.changed', $uuid, $old_uuid) if defined $old_uuid && $self->is_current;
 142     }
 143     $self->{uuid};
 144 }
 145
 146 # has uuid                    => sub { generate_uuid(printable => 1) };
 147 has icon_id                 => ICON_PASSWORD,   coerce => \&to_icon_constant;
 148 has custom_icon_uuid        => undef,           coerce => \&to_uuid;
 149 has foreground_color        => '',              coerce => \&to_string;
 150 has background_color        => '',              coerce => \&to_string;
 151 has override_url            => '',              coerce => \&to_string;
 152 has tags                    => '',              coerce => \&to_string;
 153 has auto_type               => {};
 154 has previous_parent_group   => undef,           coerce => \&to_uuid;
 155 has quality_check           => true,            coerce => \&to_bool;
 156 has strings                 => {};
 157 has binaries                => {};
 158 has times                   => {};
 159 # has custom_data             => {};
 160 # has history                 => [];
 161
 162 has last_modification_time  => sub { gmtime }, store => 'times', coerce => \&to_time;
 163 has creation_time           => sub { gmtime }, store => 'times', coerce => \&to_time;
 164 has last_access_time        => sub { gmtime }, store => 'times', coerce => \&to_time;
 165 has expiry_time             => sub { gmtime }, store => 'times', coerce => \&to_time;
 166 has expires                 => false,          store => 'times', coerce => \&to_bool;
 167 has usage_count             => 0,              store => 'times', coerce => \&to_number;
 168 has location_changed        => sub { gmtime }, store => 'times', coerce => \&to_time;
 169
 170 # has 'auto_type.auto_type_enabled'                   => true, coerce => \&to_bool;
 171 has 'auto_type_obfuscation' => 0, path => 'auto_type.data_transfer_obfuscation',
 172     coerce => \&to_number;
 173 has 'auto_type_default_sequence'          => '{USERNAME}{TAB}{PASSWORD}{ENTER}',
 174     path => 'auto_type.default_sequence', coerce => \&to_string;
 175 has 'auto_type_associations'              => [], path => 'auto_type.associations';
 176
 177 my %ATTRS_STRINGS = (
 178     title                   => 'Title',
 179     username                => 'UserName',
 180     password                => 'Password',
 181     url                     => 'URL',
 182     notes                   => 'Notes',
 183 );
 184 while (my ($attr, $string_key) = each %ATTRS_STRINGS) {
 185     no strict 'refs'; ## no critic (ProhibitNoStrict)
 186     *{$attr} = sub { shift->string_value($string_key, @_) };
 187     *{"expand_${attr}"} = sub { shift->expand_string_value($string_key, @_) };
 188 }
 189
 190 my @ATTRS = qw(uuid custom_data history auto_type_enabled);
 191 sub _set_nonlazy_attributes {
 192     my $self = shift;
 193     $self->$_ for @ATTRS, keys %ATTRS_STRINGS, list_attributes(ref $self);
 194 }
 195
 196 sub init {
 197     my $self = shift;
 198     my %args = @_;
 199
 200     while (my ($key, $val) = each %args) {
 201         if (my $method = $self->can($key)) {
 202             $self->$method($val);
 203         }
 204         else {
 205             $self->string($key => $val);
 206         }
 207     }
 208
 209     return $self;
 210 }
 211
 212 ##############################################################################
 213
 214 =method string
 215
 216     \%string = $entry->string($string_key);
 217
 218     $entry->string($string_key, \%string);
 219     $entry->string($string_key, %attributes);
 220     $entry->string($string_key, $value); # same as: value => $value
 221
 222 Get or set a string. Every string has a unique (to the entry) key and flags and so are returned as a hash
 223 structure. For example:
 224
 225     $string = {
 226         value   => 'Password',
 227         protect => true,    # optional
 228     };
 229
 230 Every string should have a value (but might be C<undef> due to memory protection) and these optional flags
 231 which might exist:
 232
 233 =for :list
 234 * C<protect> - Whether or not the string value should be memory-protected.
 235
 236 =cut
 237
 238 sub string {
 239     my $self = shift;
 240     my %args = @_     == 2 ? (key => shift, value => shift)
 241              : @_ % 2 == 1 ? (key => shift, @_) : @_;
 242
 243     if (!defined $args{key} && !defined $args{value}) {
 244         my %standard = (value => 1, protect => 1);
 245         my @other_keys = grep { !$standard{$_} } keys %args;
 246         if (@other_keys == 1) {
 247             my $key = $args{key} = $other_keys[0];
 248             $args{value} = delete $args{$key};
 249         }
 250     }
 251
 252     my $key = delete $args{key} or throw 'Must provide a string key to access';
 253
 254     return $self->{strings}{$key} = $args{value} if is_plain_hashref($args{value});
 255
 256     # Auto-vivify the standard strings.
 257     if (!exists $self->{strings}{$key} && $STANDARD_STRINGS{$key}) {
 258         $args{value} //= '';
 259         $args{protect} //= true if $self->_protect($key);
 260     }
 261
 262     while (my ($field, $value) = each %args) {
 263         $self->{strings}{$key}{$field} = $value;
 264     }
 265
 266     return $self->{strings}{$key};
 267 }
 268
 269 ### Get whether or not a standard string is configured to be protected
 270 sub _protect {
 271     my $self = shift;
 272     my $key  = shift;
 273     return false if !$STANDARD_STRINGS{$key};
 274     if (my $kdbx = eval { $self->kdbx }) {
 275         my $protect = $kdbx->memory_protection($key);
 276         return $protect if defined $protect;
 277     }
 278     return $key eq 'Password';
 279 }
 280
 281 =method string_value
 282
 283     $string = $entry->string_value($string_key);
 284
 285 Access a string value directly. The arguments are the same as for L</string>. Returns C<undef> if the string
 286 is not set or is currently memory-protected. This is just a shortcut for:
 287
 288     my $string = do {
 289         my $s = $entry->string(...);
 290         defined $s ? $s->{value} : undef;
 291     };
 292
 293 =cut
 294
 295 sub string_value {
 296     my $self = shift;
 297     my $string = $self->string(@_) // return undef;
 298     return $string->{value};
 299 }
 300
 301 =method expand_string_value
 302
 303     $string = $entry->expand_string_value($string_key);
 304
 305 Same as L</string_value> but will substitute placeholders and resolve field references. Any placeholders that
 306 do not expand to values are left as-is.
 307
 308 See L</Placeholders>.
 309
 310 Some placeholders (notably field references) require the entry be connected to a database and will throw an
 311 error if it is not.
 312
 313 =method expand_notes
 314
 315 Shortcut equivalent to C<< ->expand_string_value('Notes') >>.
 316
 317 =method expand_password
 318
 319 Shortcut equivalent to C<< ->expand_string_value('Password') >>.
 320
 321 =method expand_title
 322
 323 Shortcut equivalent to C<< ->expand_string_value('Title') >>.
 324
 325 =method expand_url
 326
 327 Shortcut equivalent to C<< ->expand_string_value('URL') >>.
 328
 329 =method expand_username
 330
 331 Shortcut equivalent to C<< ->expand_string_value('UserName') >>.
 332
 333 =cut
 334
 335 sub _expand_placeholder {
 336     my $self = shift;
 337     my $placeholder = shift;
 338     my $arg = shift;
 339
 340     require File::KDBX;
 341
 342     my $placeholder_key = $placeholder;
 343     if (defined $arg) {
 344         $placeholder_key = $File::KDBX::PLACEHOLDERS{"${placeholder}:${arg}"} ? "${placeholder}:${arg}"
 345                                                                               : "${placeholder}:";
 346     }
 347     return if !defined $File::KDBX::PLACEHOLDERS{$placeholder_key};
 348
 349     my $local_key = join('/', Hash::Util::FieldHash::id($self), $placeholder_key);
 350     local $PLACEHOLDERS{$local_key} = my $handler = $PLACEHOLDERS{$local_key} // do {
 351         my $handler = $File::KDBX::PLACEHOLDERS{$placeholder_key} or next;
 352         memoize recurse_limit($handler, $PLACEHOLDER_MAX_DEPTH, sub {
 353             alert "Detected deep recursion while expanding $placeholder placeholder",
 354                 placeholder => $placeholder;
 355             return; # undef
 356         });
 357     };
 358
 359     return $handler->($self, $arg, $placeholder);
 360 }
 361
 362 sub _expand_string {
 363     my $self    = shift;
 364     my $str     = shift;
 365
 366     my $expand = memoize $self->can('_expand_placeholder'), $self;
 367
 368     # placeholders (including field references):
 369     $str =~ s!\{([^:\}]+)(?::([^\}]*))?\}!$expand->(uc($1), $2, @_) // $&!egi;
 370
 371     # environment variables (alt syntax):
 372     my $vars = join('|', map { quotemeta($_) } keys %ENV);
 373     $str =~ s!\%($vars)\%!$expand->(ENV => $1, @_) // $&!eg;
 374
 375     return $str;
 376 }
 377
 378 sub expand_string_value {
 379     my $self = shift;
 380     my $str  = $self->string_peek(@_) // return undef;
 381     my $cleanup = erase_scoped $str;
 382     return $self->_expand_string($str);
 383 }
 384
 385 =method other_strings
 386
 387     $other = $entry->other_strings;
 388     $other = $entry->other_strings($delimiter);
 389
 390 Get a concatenation of all non-standard string values. The default delimiter is a newline. This is is useful
 391 for executing queries to search for entities based on the contents of these other strings (if any).
 392
 393 =cut
 394
 395 sub other_strings {
 396     my $self    = shift;
 397     my $delim   = shift // "\n";
 398
 399     my @strings = map { $self->string_value($_) } grep { !$STANDARD_STRINGS{$_} } sort keys %{$self->strings};
 400     return join($delim, @strings);
 401 }
 402
 403 =method string_peek
 404
 405     $string = $entry->string_peek($string_key);
 406
 407 Same as L</string_value> but can also retrieve the value from protected-memory if the value is currently
 408 protected.
 409
 410 =cut
 411
 412 sub string_peek {
 413     my $self = shift;
 414     my $string = $self->string(@_);
 415     return defined $string->{value} ? $string->{value} : $self->kdbx->peek($string);
 416 }
 417
 418 ##############################################################################
 419
 420 =method add_auto_type_association
 421
 422     $entry->add_auto_type_association(\%association);
 423
 424 Add a new auto-type association to an entry.
 425
 426 =cut
 427
 428 sub add_auto_type_association {
 429     my $self        = shift;
 430     my $association = shift;
 431     push @{$self->auto_type_associations}, $association;
 432 }
 433
 434 =method expand_keystroke_sequence
 435
 436     $string = $entry->expand_keystroke_sequence($keystroke_sequence);
 437     $string = $entry->expand_keystroke_sequence(\%association);
 438     $string = $entry->expand_keystroke_sequence;    # use default auto-type sequence
 439
 440 Get a keystroke sequence after placeholder expansion.
 441
 442 =cut
 443
 444 sub expand_keystroke_sequence {
 445     my $self = shift;
 446     my $association = shift;
 447
 448     my $keys;
 449     if ($association) {
 450         $keys = is_hashref($association) && exists $association->{keystroke_sequence} ?
 451         $association->{keystroke_sequence} : defined $association ? $association : '';
 452     }
 453
 454     $keys = $self->auto_type_default_sequence if !$keys;
 455     # TODO - Fall back to getting default sequence from parent group, which probably means we shouldn't be
 456     # setting a default value in the entry..
 457
 458     return $self->_expand_string($keys);
 459 }
 460
 461 ##############################################################################
 462
 463 =method binary
 464
 465     \%binary = $entry->binary($binary_key);
 466
 467     $entry->binary($binary_key, \%binary);
 468     $entry->binary($binary_key, %attributes);
 469     $entry->binary($binary_key, $value); # same as: value => $value
 470
 471 Get or set a binary. Every binary has a unique (to the entry) key and flags and so are returned as a hash
 472 structure. For example:
 473
 474     $binary = {
 475         value   => '...',
 476         protect => true,    # optional
 477     };
 478
 479 Every binary should have a value (but might be C<undef> due to memory protection) and these optional flags
 480 which might exist:
 481
 482 =for :list
 483 * C<protect> - Whether or not the binary value should be memory-protected.
 484
 485 =cut
 486
 487 sub binary {
 488     my $self = shift;
 489     my %args = @_     == 2 ? (key => shift, value => shift)
 490              : @_ % 2 == 1 ? (key => shift, @_) : @_;
 491
 492     if (!defined $args{key} && !defined $args{value}) {
 493         my %standard = (value => 1, protect => 1);
 494         my @other_keys = grep { !$standard{$_} } keys %args;
 495         if (@other_keys == 1) {
 496             my $key = $args{key} = $other_keys[0];
 497             $args{value} = delete $args{$key};
 498         }
 499     }
 500
 501     my $key = delete $args{key} or throw 'Must provide a binary key to access';
 502
 503     return $self->{binaries}{$key} = $args{value} if is_plain_hashref($args{value});
 504
 505     assert { !defined $args{value} || !utf8::is_utf8($args{value}) };
 506     while (my ($field, $value) = each %args) {
 507         $self->{binaries}{$key}{$field} = $value;
 508     }
 509     return $self->{binaries}{$key};
 510 }
 511
 512 =method binary_value
 513
 514     $binary = $entry->binary_value($binary_key);
 515
 516 Access a binary value directly. The arguments are the same as for L</binary>. Returns C<undef> if the binary
 517 is not set or is currently memory-protected. This is just a shortcut for:
 518
 519     my $binary = do {
 520         my $b = $entry->binary(...);
 521         defined $b ? $b->{value} : undef;
 522     };
 523
 524 =cut
 525
 526 sub binary_value {
 527     my $self = shift;
 528     my $binary = $self->binary(@_) // return undef;
 529     return $binary->{value};
 530 }
 531
 532 ##############################################################################
 533
 534 =method hmac_otp
 535
 536     $otp = $entry->hmac_otp(%options);
 537
 538 Generate an HMAC-based one-time password, or C<undef> if HOTP is not configured for the entry. The entry's
 539 strings generally must first be unprotected, just like when accessing the password. Valid options are:
 540
 541 =for :list
 542 * C<counter> - Specify the counter value
 543
 544 To configure HOTP, see L</"One-time Passwords">.
 545
 546 =cut
 547
 548 sub hmac_otp {
 549     my $self = shift;
 550     load_optional('Pass::OTP');
 551
 552     my %params = ($self->_hotp_params, @_);
 553     return if !defined $params{type} || !defined $params{secret};
 554
 555     $params{secret} = encode_b32r($params{secret}) if !$params{base32};
 556     $params{base32} = 1;
 557
 558     my $otp = eval { Pass::OTP::otp(%params, @_) };
 559     if (my $err = $@) {
 560         throw 'Unable to generate HOTP', error => $err;
 561     }
 562
 563     $self->_hotp_increment_counter($params{counter});
 564
 565     return $otp;
 566 }
 567
 568 =method time_otp
 569
 570     $otp = $entry->time_otp(%options);
 571
 572 Generate a time-based one-time password, or C<undef> if TOTP is not configured for the entry. The entry's
 573 strings generally must first be unprotected, just like when accessing the password. Valid options are:
 574
 575 =for :list
 576 * C<now> - Specify the value for determining the time-step counter
 577
 578 To configure TOTP, see L</"One-time Passwords">.
 579
 580 =cut
 581
 582 sub time_otp {
 583     my $self = shift;
 584     load_optional('Pass::OTP');
 585
 586     my %params = ($self->_totp_params, @_);
 587     return if !defined $params{type} || !defined $params{secret};
 588
 589     $params{secret} = encode_b32r($params{secret}) if !$params{base32};
 590     $params{base32} = 1;
 591
 592     my $otp = eval { Pass::OTP::otp(%params, @_) };
 593     if (my $err = $@) {
 594         throw 'Unable to generate TOTP', error => $err;
 595     }
 596
 597     return $otp;
 598 }
 599
 600 =method hmac_otp_uri
 601
 602 =method time_otp_uri
 603
 604     $uri_string = $entry->hmac_otp_uri;
 605     $uri_string = $entry->time_otp_uri;
 606
 607 Get a HOTP or TOTP otpauth URI for the entry, if available.
 608
 609 To configure OTP, see L</"One-time Passwords">.
 610
 611 =cut
 612
 613 sub hmac_otp_uri { $_[0]->_otp_uri($_[0]->_hotp_params) }
 614 sub time_otp_uri { $_[0]->_otp_uri($_[0]->_totp_params) }
 615
 616 sub _otp_uri {
 617     my $self = shift;
 618     my %params = @_;
 619
 620     return if 4 != grep { defined } @params{qw(type secret issuer account)};
 621     return if $params{type} !~ /^[ht]otp$/i;
 622
 623     my $label = delete $params{label};
 624     $params{$_} = uri_escape_utf8($params{$_}) for keys %params;
 625
 626     my $type    = lc($params{type});
 627     my $issuer  = $params{issuer};
 628     my $account = $params{account};
 629
 630     $label //= "$issuer:$account";
 631
 632     my $secret = $params{secret};
 633     $secret = uc(encode_b32r($secret)) if !$params{base32};
 634
 635     delete $params{algorithm} if defined $params{algorithm} && $params{algorithm} eq 'sha1';
 636     delete $params{period}    if defined $params{period} && $params{period} == 30;
 637     delete $params{digits}    if defined $params{digits} && $params{digits} == 6;
 638     delete $params{counter}   if defined $params{counter} && $params{counter} == 0;
 639
 640     my $uri = "otpauth://$type/$label?secret=$secret&issuer=$issuer";
 641
 642     if (defined $params{encoder}) {
 643         $uri .= "&encoder=$params{encoder}";
 644         return $uri;
 645     }
 646     $uri .= '&algorithm=' . uc($params{algorithm}) if defined $params{algorithm};
 647     $uri .= "&digits=$params{digits}"   if defined $params{digits};
 648     $uri .= "&counter=$params{counter}" if defined $params{counter};
 649     $uri .= "&period=$params{period}"   if defined $params{period};
 650
 651     return $uri;
 652 }
 653
 654 sub _hotp_params {
 655     my $self = shift;
 656
 657     my %params = (
 658         type    => 'hotp',
 659         issuer  => $self->expand_title      || 'KDBX',
 660         account => $self->expand_username   || 'none',
 661         digits  => 6,
 662         counter => $self->string_value('HmacOtp-Counter') // 0,
 663         $self->_otp_secret_params('Hmac'),
 664     );
 665     return %params if $params{secret};
 666
 667     my %otp_params = $self->_otp_params;
 668     return () if !$otp_params{secret} || $otp_params{type} ne 'hotp';
 669
 670     # $otp_params{counter} = 0
 671
 672     return (%params, %otp_params);
 673 }
 674
 675 sub _totp_params {
 676     my $self = shift;
 677
 678     my %algorithms = (
 679         'HMAC-SHA-1'    => 'sha1',
 680         'HMAC-SHA-256'  => 'sha256',
 681         'HMAC-SHA-512'  => 'sha512',
 682     );
 683     my %params = (
 684         type        => 'totp',
 685         issuer      => $self->expand_title      || 'KDBX',
 686         account     => $self->expand_username   || 'none',
 687         digits      => $self->string_value('TimeOtp-Length') // 6,
 688         algorithm   => $algorithms{$self->string_value('TimeOtp-Algorithm') || ''} || 'sha1',
 689         period      => $self->string_value('TimeOtp-Period') // 30,
 690         $self->_otp_secret_params('Time'),
 691     );
 692     return %params if $params{secret};
 693
 694     my %otp_params = $self->_otp_params;
 695     return () if !$otp_params{secret} || $otp_params{type} ne 'totp';
 696
 697     return (%params, %otp_params);
 698 }
 699
 700 # KeePassXC style
 701 sub _otp_params {
 702     my $self = shift;
 703     load_optional('Pass::OTP::URI');
 704
 705     my $uri = $self->string_value('otp') || '';
 706     my %params;
 707     %params = Pass::OTP::URI::parse($uri) if $uri =~ m!^otpauth://!;
 708     return () if !$params{secret} || !$params{type};
 709
 710     if (($params{encoder} // '') eq 'steam') {
 711         $params{digits} = 5;
 712         $params{chars}  = '23456789BCDFGHJKMNPQRTVWXY';
 713     }
 714
 715     # Pass::OTP::URI doesn't provide the issuer and account separately, so get them from the label
 716     my ($issuer, $user) = split(':', $params{label} // ':', 2);
 717     $params{issuer}  //= uri_unescape_utf8($issuer);
 718     $params{account} //= uri_unescape_utf8($user);
 719
 720     $params{algorithm}  = lc($params{algorithm}) if $params{algorithm};
 721     $params{counter}    = $self->string_value('HmacOtp-Counter') if $params{type} eq 'hotp';
 722
 723     return %params;
 724 }
 725
 726 sub _otp_secret_params {
 727     my $self = shift;
 728     my $type = shift // return ();
 729
 730     my $secret_txt = $self->string_value("${type}Otp-Secret");
 731     my $secret_hex = $self->string_value("${type}Otp-Secret-Hex");
 732     my $secret_b32 = $self->string_value("${type}Otp-Secret-Base32");
 733     my $secret_b64 = $self->string_value("${type}Otp-Secret-Base64");
 734
 735     my $count = grep { defined } ($secret_txt, $secret_hex, $secret_b32, $secret_b64);
 736     return () if $count == 0;
 737     alert "Found multiple ${type}Otp-Secret strings", count => $count if 1 < $count;
 738
 739     return (secret => $secret_b32, base32 => 1) if defined $secret_b32;
 740     return (secret => decode_b64($secret_b64))  if defined $secret_b64;
 741     return (secret => pack('H*', $secret_hex))  if defined $secret_hex;
 742     return (secret => encode('UTF-8', $secret_txt));
 743 }
 744
 745 sub _hotp_increment_counter {
 746     my $self    = shift;
 747     my $counter = shift // $self->string_value('HmacOtp-Counter') || 0;
 748
 749     looks_like_number($counter) or throw 'HmacOtp-Counter value must be a number', value => $counter;
 750     my $next = $counter + 1;
 751     $self->string('HmacOtp-Counter', $next);
 752     return $next;
 753 }
 754
 755 ##############################################################################
 756
 757 =method size
 758
 759     $size = $entry->size;
 760
 761 Get the size (in bytes) of an entry.
 762
 763 B<NOTE:> This is not an exact figure because there is no canonical serialization of an entry. This size should
 764 only be used as a rough estimate for comparison with other entries or to impose data size limitations.
 765
 766 =cut
 767
 768 sub size {
 769     my $self = shift;
 770
 771     my $size = 0;
 772
 773     # tags
 774     $size += length(encode('UTF-8', $self->tags // ''));
 775
 776     # attributes (strings)
 777     while (my ($key, $string) = each %{$self->strings}) {
 778         next if !defined $string->{value};
 779         $size += length(encode('UTF-8', $key)) + length(encode('UTF-8', $string->{value} // ''));
 780     }
 781
 782     # custom data
 783     while (my ($key, $item) = each %{$self->custom_data}) {
 784         next if !defined $item->{value};
 785         $size += length(encode('UTF-8', $key)) + length(encode('UTF-8', $item->{value} // ''));
 786     }
 787
 788     # binaries
 789     while (my ($key, $binary) = each %{$self->binaries}) {
 790         next if !defined $binary->{value};
 791         my $value_len = utf8::is_utf8($binary->{value}) ? length(encode('UTF-8', $binary->{value}))
 792             : length($binary->{value});
 793         $size += length(encode('UTF-8', $key)) + $value_len;
 794     }
 795
 796     # autotype associations
 797     for my $association (@{$self->auto_type->{associations} || []}) {
 798         $size += length(encode('UTF-8', $association->{window}))
 799             + length(encode('UTF-8', $association->{keystroke_sequence} // ''));
 800     }
 801
 802     return $size;
 803 }
 804
 805 ##############################################################################
 806
 807 sub history {
 808     my $self = shift;
 809     my $entries = $self->{history} //= [];
 810     if (@$entries && !blessed($entries->[0])) {
 811         @$entries = map { $self->_wrap_entry($_, $self->kdbx) } @$entries;
 812     }
 813     assert { !any { !blessed $_ } @$entries };
 814     return $entries;
 815 }
 816
 817 =method history_size
 818
 819     $size = $entry->history_size;
 820
 821 Get the size (in bytes) of all historical entries combined.
 822
 823 =cut
 824
 825 sub history_size {
 826     my $self = shift;
 827     return sum0 map { $_->size } @{$self->history};
 828 }
 829
 830 =method prune_history
 831
 832     @removed_historical_entries = $entry->prune_history(%options);
 833
 834 Remove just as many older historical entries as necessary to get under the database limits. The limits are
 835 taken from the connected database (if any) or can be overridden with C<%options>:
 836
 837 =for :list
 838 * C<max_items> - Maximum number of historical entries to keep (default: 10, no limit: -1)
 839 * C<max_size> - Maximum total size (in bytes) of historical entries to keep (default: 6 MiB, no limit: -1)
 840 * C<max_age> - Maximum age (in days) of historical entries to keep (default: 365, no limit: -1)
 841
 842 =cut
 843
 844 sub prune_history {
 845     my $self = shift;
 846     my %args = @_;
 847
 848     my $max_items = $args{max_items} // eval { $self->kdbx->history_max_items } // HISTORY_DEFAULT_MAX_ITEMS;
 849     my $max_size  = $args{max_size}  // eval { $self->kdbx->history_max_size }  // HISTORY_DEFAULT_MAX_SIZE;
 850     my $max_age   = $args{max_age}   // eval { $self->kdbx->maintenance_history_days } // HISTORY_DEFAULT_MAX_AGE;
 851
 852     # history is ordered oldest to newest
 853     my $history = $self->history;
 854
 855     my @removed;
 856
 857     if (0 <= $max_items && $max_items < @$history) {
 858         push @removed, splice @$history, -$max_items;
 859     }
 860
 861     if (0 <= $max_size) {
 862         my $current_size = $self->history_size;
 863         while ($max_size < $current_size) {
 864             push @removed, my $entry = shift @$history;
 865             $current_size -= $entry->size;
 866         }
 867     }
 868
 869     if (0 <= $max_age) {
 870         my $cutoff = gmtime - ($max_age * 86400);
 871         for (my $i = @$history - 1; 0 <= $i; --$i) {
 872             my $entry = $history->[$i];
 873             next if $cutoff <= $entry->last_modification_time;
 874             push @removed, splice @$history, $i, 1;
 875         }
 876     }
 877
 878     @removed = sort { $a->last_modification_time <=> $b->last_modification_time } @removed;
 879     return @removed;
 880 }
 881
 882 =method add_historical_entry
 883
 884     $entry->add_historical_entry($entry);
 885
 886 Add an entry to the history.
 887
 888 =cut
 889
 890 sub add_historical_entry {
 891     my $self = shift;
 892     delete $_->{history} for @_;
 893     push @{$self->{history} //= []}, map { $self->_wrap_entry($_) } @_;
 894 }
 895
 896 =method remove_historical_entry
 897
 898     $entry->remove_historical_entry($historical_entry);
 899
 900 Remove an entry from the history.
 901
 902 =cut
 903
 904 sub remove_historical_entry {
 905     my $self    = shift;
 906     my $entry   = shift;
 907     my $history = $self->history;
 908
 909     my @removed;
 910     for (my $i = @$history - 1; 0 <= $i; --$i) {
 911         my $item = $history->[$i];
 912         next if Hash::Util::FieldHash::id($entry) != Hash::Util::FieldHash::id($item);
 913         push @removed, splice @{$self->{history}}, $i, 1;
 914     }
 915     return @removed;
 916 }
 917
 918 =method current_entry
 919
 920     $current_entry = $entry->current_entry;
 921
 922 Get an entry's current entry. If the entry itself is current (not historical), itself is returned.
 923
 924 =cut
 925
 926 sub current_entry {
 927     my $self    = shift;
 928     my $parent  = $self->group;
 929
 930     if ($parent) {
 931         my $id = $self->uuid;
 932         my $entry = first { $id eq $_->uuid } @{$parent->entries};
 933         return $entry if $entry;
 934     }
 935
 936     return $self;
 937 }
 938
 939 =method is_current
 940
 941     $bool = $entry->is_current;
 942
 943 Get whether or not an entry is considered current (i.e. not historical). An entry is current if it is directly
 944 in the parent group's entry list.
 945
 946 =cut
 947
 948 sub is_current {
 949     my $self    = shift;
 950     my $current = $self->current_entry;
 951     return Hash::Util::FieldHash::id($self) == Hash::Util::FieldHash::id($current);
 952 }
 953
 954 =method is_historical
 955
 956     $bool = $entry->is_historical;
 957
 958 Get whether or not an entry is considered historical (i.e. not current).
 959
 960 This is just the inverse of L</is_current>.
 961
 962 =cut
 963
 964 sub is_historical { !$_[0]->is_current }
 965
 966 =method remove
 967
 968     $entry = $entry->remove;
 969
 970 Remove an entry from its parent group. If the entry is historical, remove it from the history of the current
 971 entry. If the entry is current, this behaves the same as L<File::KDBX::Object/remove>.
 972
 973 =cut
 974
 975 sub remove {
 976     my $self    = shift;
 977     my $current = $self->current_entry;
 978     return $self if $current->remove_historical_entry($self);
 979     $self->SUPER::remove(@_);
 980 }
 981
 982 ##############################################################################
 983
 984 =method searching_enabled
 985
 986     $bool = $entry->searching_enabled;
 987
 988 Get whether or not an entry may show up in search results. This is determine from the entry's parent group's
 989 L<File::KDBX::Group/effective_enable_searching> value.
 990
 991 Throws if entry has no parent group or if the entry is not connected to a database.
 992
 993 =cut
 994
 995 sub searching_enabled {
 996     my $self = shift;
 997     my $parent = $self->group;
 998     return $parent->effective_enable_searching if $parent;
 999     return true;
1000 }
1001
1002 sub auto_type_enabled {
1003     my $self = shift;
1004     $self->auto_type->{enabled} = to_bool(shift) if @_;
1005     $self->auto_type->{enabled} //= true;
1006     return false if !$self->auto_type->{enabled};
1007     return true if !$self->is_connected;
1008     my $parent = $self->group;
1009     return $parent->effective_enable_auto_type if $parent;
1010     return true;
1011 }
1012
1013 ##############################################################################
1014
1015 sub _signal {
1016     my $self = shift;
1017     my $type = shift;
1018     return $self->SUPER::_signal("entry.$type", @_);
1019 }
1020
1021 sub _commit {
1022     my $self = shift;
1023     my $orig = shift;
1024     $self->add_historical_entry($orig);
1025     my $time = gmtime;
1026     $self->last_modification_time($time);
1027     $self->last_access_time($time);
1028 }
1029
1030 sub label { shift->expand_title(@_) }
1031
1032 ### Name of the parent attribute expected to contain the object
1033 sub _parent_container { 'entries' }
1034
1035 1;
1036 __END__
1037
1038 =for Pod::Coverage auto_type times
1039
1040 =head1 DESCRIPTION
1041
1042 An entry in a KDBX database is a record that can contains strings (also called "fields") and binaries (also
1043 called "files" or "attachments"). Every string and binary has a key or name. There is a default set of strings
1044 that every entry has:
1045
1046 =for :list
1047 * B<Title>
1048 * B<UserName>
1049 * B<Password>
1050 * B<URL>
1051 * B<Notes>
1052
1053 Beyond this, you can store any number of other strings and any number of binaries that you can use for
1054 whatever purpose you want.
1055
1056 There is also some metadata associated with an entry. Each entry in a database is identified uniquely by
1057 a UUID. An entry can also have an icon associated with it, and there are various timestamps. Take a look at
1058 the attributes to see what's available.
1059
1060 A B<File::KDBX::Entry> is a subclass of L<File::KDBX::Object>. View its documentation to see other attributes
1061 and methods available on entries.
1062
1063 =head2 Placeholders
1064
1065 Entry string and auto-type key sequences can have placeholders or template tags that can be replaced by other
1066 values. Placeholders can appear like C<{PLACEHOLDER}>. For example, a B<URL> string might have a value of
1067 C<http://example.com?user={USERNAME}>. C<{USERNAME}> is a placeholder for the value of the B<UserName> string
1068 of the same entry. If the B<UserName> string had a value of "batman", the B<URL> string would expand to
1069 C<http://example.com?user=batman>.
1070
1071 Some placeholders take an argument, where the argument follows the tag after a colon but before the closing
1072 brace, like C<{PLACEHOLDER:ARGUMENT}>.
1073
1074 Placeholders are documented in the L<KeePass Help Center|https://keepass.info/help/base/placeholders.html>.
1075 This software supports many (but not all) of the placeholders documented there.
1076
1077 =head3 Entry Placeholders
1078
1079 =for :list
1080 * ☑ C<{TITLE}> - B<Title> string
1081 * ☑ C<{USERNAME}> - B<UserName> string
1082 * ☑ C<{PASSWORD}> - B<Password> string
1083 * ☑ C<{NOTES}> - B<Notes> string
1084 * ☑ C<{URL}> - B<URL> string
1085 * ☑ C<{URL:SCM}> / C<{URL:SCHEME}>
1086 * ☑ C<{URL:USERINFO}>
1087 * ☑ C<{URL:USERNAME}>
1088 * ☑ C<{URL:PASSWORD}>
1089 * ☑ C<{URL:HOST}>
1090 * ☑ C<{URL:PORT}>
1091 * ☑ C<{URL:PATH}>
1092 * ☑ C<{URL:QUERY}>
1093 * ☑ C<{URL:FRAGMENT}> / C<{URL:HASH}>
1094 * ☑ C<{URL:RMVSCM}> / C<{URL:WITHOUTSCHEME}>
1095 * ☑ C<{S:Name}> - Custom string where C<Name> is the name or key of the string
1096 * ☑ C<{UUID}> - Identifier (32 hexidecimal characters)
1097 * ☑ C<{HMACOTP}> - Generate an HMAC-based one-time password (its counter B<will> be incremented)
1098 * ☑ C<{TIMEOTP}> - Generate a time-based one-time password
1099 * ☑ C<{GROUP_NOTES}> - Notes of the parent group
1100 * ☑ C<{GROUP_PATH}> - Full path of the parent group
1101 * ☑ C<{GROUP}> - Name of the parent group
1102
1103 =head3 Field References
1104
1105 =for :list
1106 * ☑ C<{REF:Wanted@SearchIn:Text}> - See L<File::KDBX/resolve_reference>
1107
1108 =head3 File path Placeholders
1109
1110 =for :list
1111 * ☑ C<{APPDIR}> - Program directory path
1112 * ☑ C<{FIREFOX}> - Path to the Firefox browser executable
1113 * ☑ C<{GOOGLECHROME}> - Path to the Chrome browser executable
1114 * ☑ C<{INTERNETEXPLORER}> - Path to the Firefox browser executable
1115 * ☑ C<{OPERA}> - Path to the Opera browser executable
1116 * ☑ C<{SAFARI}> - Path to the Safari browser executable
1117 * ☒ C<{DB_PATH}> - Full file path of the database
1118 * ☒ C<{DB_DIR}> - Directory path of the database
1119 * ☒ C<{DB_NAME}> - File name (including extension) of the database
1120 * ☒ C<{DB_BASENAME}> - File name (excluding extension) of the database
1121 * ☒ C<{DB_EXT}> - File name extension
1122 * ☑ C<{ENV_DIRSEP}> - Directory separator
1123 * ☑ C<{ENV_PROGRAMFILES_X86}> - One of C<%ProgramFiles(x86)%> or C<%ProgramFiles%>
1124
1125 =head3 Date and Time Placeholders
1126
1127 =for :list
1128 * ☑ C<{DT_SIMPLE}> - Current local date and time as a sortable string
1129 * ☑ C<{DT_YEAR}> - Year component of the current local date
1130 * ☑ C<{DT_MONTH}> - Month component of the current local date
1131 * ☑ C<{DT_DAY}> - Day component of the current local date
1132 * ☑ C<{DT_HOUR}> - Hour component of the current local time
1133 * ☑ C<{DT_MINUTE}> - Minute component of the current local time
1134 * ☑ C<{DT_SECOND}> - Second component of the current local time
1135 * ☑ C<{DT_UTC_SIMPLE}> - Current UTC date and time as a sortable string
1136 * ☑ C<{DT_UTC_YEAR}> - Year component of the current UTC date
1137 * ☑ C<{DT_UTC_MONTH}> - Month component of the current UTC date
1138 * ☑ C<{DT_UTC_DAY}> - Day component of the current UTC date
1139 * ☑ C<{DT_UTC_HOUR}> - Hour component of the current UTC time
1140 * ☑ C<{DT_UTC_MINUTE}> Minute Year component of the current UTC time
1141 * ☑ C<{DT_UTC_SECOND}> - Second component of the current UTC time
1142
1143 If the current date and time is C<2012-07-25 17:05:34>, the "simple" form would be C<20120725170534>.
1144
1145 =head3 Special Key Placeholders
1146
1147 Certain placeholders for use in auto-type key sequences are not supported for replacement, but they will
1148 remain as-is so that an auto-type engine (not included) can parse and replace them with the appropriate
1149 virtual key presses. For completeness, here is the list that the KeePass program claims to support:
1150
1151 C<{TAB}>, C<{ENTER}>, C<{UP}>, C<{DOWN}>, C<{LEFT}>, C<{RIGHT}>, C<{HOME}>, C<{END}>, C<{PGUP}>, C<{PGDN}>,
1152 C<{INSERT}>, C<{DELETE}>, C<{SPACE}>
1153
1154 C<{BACKSPACE}>, C<{BREAK}>, C<{CAPSLOCK}>, C<{ESC}>, C<{WIN}>, C<{LWIN}>, C<{RWIN}>, C<{APPS}>, C<{HELP}>,
1155 C<{NUMLOCK}>, C<{PRTSC}>, C<{SCROLLLOCK}>
1156
1157 C<{F1}>, C<{F2}>, C<{F3}>, C<{F4}>, C<{F5}>, C<{F6}>, C<{F7}>, C<{F8}>, C<{F9}>, C<{F10}>, C<{F11}>, C<{F12}>,
1158 C<{F13}>, C<{F14}>, C<{F15}>, C<{F16}>
1159
1160 C<{ADD}>, C<{SUBTRACT}>, C<{MULTIPLY}>, C<{DIVIDE}>, C<{NUMPAD0}>, C<{NUMPAD1}>, C<{NUMPAD2}>, C<{NUMPAD3}>,
1161 C<{NUMPAD4}>, C<{NUMPAD5}>, C<{NUMPAD6}>, C<{NUMPAD7}>, C<{NUMPAD8}>, C<{NUMPAD9}>
1162
1163 =head3 Miscellaneous Placeholders
1164
1165 =for :list
1166 * ☒ C<{BASE}>
1167 * ☒ C<{BASE:SCM}> / C<{BASE:SCHEME}>
1168 * ☒ C<{BASE:USERINFO}>
1169 * ☒ C<{BASE:USERNAME}>
1170 * ☒ C<{BASE:PASSWORD}>
1171 * ☒ C<{BASE:HOST}>
1172 * ☒ C<{BASE:PORT}>
1173 * ☒ C<{BASE:PATH}>
1174 * ☒ C<{BASE:QUERY}>
1175 * ☒ C<{BASE:FRAGMENT}> / C<{BASE:HASH}>
1176 * ☒ C<{BASE:RMVSCM}> / C<{BASE:WITHOUTSCHEME}>
1177 * ☒ C<{CLIPBOARD-SET:/Text/}>
1178 * ☒ C<{CLIPBOARD}>
1179 * ☒ C<{CMD:/CommandLine/Options/}>
1180 * ☑ C<{C:Comment}> - Comments are simply replaced by nothing
1181 * ☑ C<{ENV:}> and C<%ENV%> - Environment variables
1182 * ☒ C<{GROUP_SEL_NOTES}>
1183 * ☒ C<{GROUP_SEL_PATH}>
1184 * ☒ C<{GROUP_SEL}>
1185 * ☒ C<{NEWPASSWORD}>
1186 * ☒ C<{NEWPASSWORD:/Profile/}>
1187 * ☒ C<{PASSWORD_ENC}>
1188 * ☒ C<{PICKCHARS}>
1189 * ☒ C<{PICKCHARS:Field:Options}>
1190 * ☒ C<{PICKFIELD}>
1191 * ☒ C<{T-CONV:/Text/Type/}>
1192 * ☒ C<{T-REPLACE-RX:/Text/Type/Replace/}>
1193
1194 Some of these that remain unimplemented, such as C<{CLIPBOARD}>, cannot be implemented portably. Some of these
1195 I haven't implemented (yet) just because they don't seem very useful. You can create your own placeholder to
1196 augment the list of default supported placeholders or to replace a built-in placeholder handler. To create
1197 a placeholder, just set it in the C<%File::KDBX::PLACEHOLDERS> hash. For example:
1198
1199     $File::KDBX::PLACEHOLDERS{'MY_PLACEHOLDER'} = sub {
1200         my ($entry) = @_;
1201         ...;
1202     };
1203
1204 If the placeholder is expanded in the context of an entry, C<$entry> is the B<File::KDBX::Entry> object in
1205 context. Otherwise it is C<undef>. An entry is in context if, for example, the placeholder is in an entry's
1206 strings or auto-type key sequences.
1207
1208     $File::KDBX::PLACEHOLDERS{'MY_PLACEHOLDER:'} = sub {
1209         my ($entry, $arg) = @_;         #    ^ Notice the colon here
1210         ...;
1211     };
1212
1213 If the name of the placeholder ends in a colon, then it is expected to receive an argument. During expansion,
1214 everything after the colon and before the end of the placeholder is passed to your placeholder handler
1215 subroutine. So if the placeholder is C<{MY_PLACEHOLDER:whatever}>, C<$arg> will have the value B<whatever>.
1216
1217 An argument is required for placeholders than take one. I.e. The placeholder handler won't be called if there
1218 is no argument. If you want a placeholder to support an optional argument, you'll need to set the placeholder
1219 both with and without a colon (or they could be different subroutines):
1220
1221     $File::KDBX::PLACEHOLDERS{'RAND'} = $File::KDBX::PLACEHOLDERS{'RAND:'} = sub {
1222         (undef, my $arg) = @_;
1223         return defined $arg ? rand($arg) : rand;
1224     };
1225
1226 You can also remove placeholder handlers. If you want to disable placeholder expansion entirely, just delete
1227 all the handlers:
1228
1229     %File::KDBX::PLACEHOLDERS = ();
1230
1231 =head2 One-time Passwords
1232
1233 An entry can be configured to generate one-time passwords, both HOTP (HMAC-based) and TOTP (time-based). The
1234 configuration storage isn't completely standardized, but this module supports two predominant configuration
1235 styles:
1236
1237 =for :list
1238 * L<KeePass 2|https://keepass.info/help/base/placeholders.html#otp>
1239 * KeePassXC
1240
1241 B<NOTE:> To use this feature, you must install the suggested dependency:
1242
1243 =for :list
1244 * L<Pass::OTP>
1245
1246 To configure TOTP in the KeePassXC style, there is only one string to set: C<otp>. The value should be any
1247 valid otpauth URI. When generating an OTP, all of the relevant OTP properties are parsed from the URI.
1248
1249 To configure TOTP in the KeePass 2 style, set the following strings:
1250
1251 =for :list
1252 * C<TimeOtp-Algorithm> - Cryptographic algorithm, one of C<HMAC-SHA-1> (default), C<HMAC-SHA-256> and
1253     C<HMAC-SHA-512>
1254 * C<TimeOtp-Length> - Number of digits each one-time password is (default: 6, maximum: 8)
1255 * C<TimeOtp-Period> - Time-step size in seconds (default: 30)
1256 * C<TimeOtp-Secret> - Text string secret, OR
1257 * C<TimeOtp-Secret-Hex> - Hexidecimal-encoded secret, OR
1258 * C<TimeOtp-Secret-Base32> - Base32-encoded secret (most common), OR
1259 * C<TimeOtp-Secret-Base64> - Base64-encoded secret
1260
1261 To configure HOTP in the KeePass 2 style, set the following strings:
1262
1263 =for :list
1264 * C<HmacOtp-Counter> - Counting value in decimal, starts on C<0> by default and increments when L</hmac_otp>
1265     is called
1266 * C<HmacOtp-Secret> - Text string secret, OR
1267 * C<HmacOtp-Secret-Hex> - Hexidecimal-encoded secret, OR
1268 * C<HmacOtp-Secret-Base32> - Base32-encoded secret (most common), OR
1269 * C<HmacOtp-Secret-Base64> - Base64-encoded secret
1270
1271 B<NOTE:> The multiple "Secret" strings are simply a way to store a secret in different formats. Only one of
1272 these should actually be set or an error will be thrown.
1273
1274 Here's a basic example:
1275
1276     $entry->string(otp => 'otpauth://totp/Issuer:user?secret=NBSWY3DP&issuer=Issuer');
1277     # OR
1278     $entry->string('TimeOtp-Secret-Base32' => 'NBSWY3DP');
1279
1280     my $otp = $entry->time_otp;
1281
1282 =cut