mirror of
https://codeberg.org/scip/Crypt--PWSafe3.git
synced 2025-12-16 20:21:01 +01:00
201 lines
3.8 KiB
Perl
201 lines
3.8 KiB
Perl
package Crypt::PWSafe3::PasswordPolicy;
|
|
|
|
|
|
use Carp::Heavy;
|
|
use Carp;
|
|
use Exporter ();
|
|
use vars qw(@ISA @EXPORT);
|
|
use utf8;
|
|
|
|
$Crypt::PWSafe3::PasswordPolicy::VERSION = '1.00';
|
|
|
|
my %flagbits = (
|
|
UseLowercase => 0x8000,
|
|
UseUppercase => 0x4000,
|
|
UseDigits => 0x2000,
|
|
UseSymbols => 0x1000,
|
|
UseHexDigits => 0x0800,
|
|
UseEasyVision => 0x0400,
|
|
MakePronounceable => 0x0200
|
|
);
|
|
|
|
|
|
my @flags = qw(UseLowercase UseUppercase UseDigits UseSymbols UseHexDigits UseEasyVision MakePronounceable);
|
|
my @fields = qw(raw MaxLength MinLowercase MinUppercase MinDigits MinSymbols);
|
|
|
|
foreach my $field (@fields, @flags) {
|
|
eval qq(
|
|
*Crypt::PWSafe3::PasswordPolicy::$field = sub {
|
|
my(\$this, \$arg) = \@_;
|
|
if (\$arg) {
|
|
return \$this->{$field} = \$arg;
|
|
}
|
|
else {
|
|
return \$this->{$field};
|
|
}
|
|
}
|
|
);
|
|
}
|
|
|
|
sub new {
|
|
#
|
|
# new PasswordPolicy object
|
|
my($this, %param) = @_;
|
|
my $class = ref($this) || $this;
|
|
my $self = \%param;
|
|
bless($self, $class);
|
|
|
|
|
|
if (exists $param{raw}) {
|
|
$self->decode($param{raw});
|
|
}
|
|
else {
|
|
foreach my $field (@fields, @flags) {
|
|
if(exists $param{$field}) {
|
|
$self->{$field} = $param{$field};
|
|
}
|
|
else {
|
|
$self->{$field} = 0;
|
|
}
|
|
}
|
|
}
|
|
|
|
return $self;
|
|
}
|
|
|
|
|
|
sub decode {
|
|
my($this, $raw) = @_;
|
|
|
|
# expected input: ffffnnnllluuudddsss
|
|
|
|
# create a 6-elemt array
|
|
my @exp = unpack("A4A3A3A3A3A3", $raw);
|
|
|
|
# convert the hex strings to integers
|
|
my %pwpol;
|
|
foreach my $i (0 .. 5) {
|
|
$pwpol{$fields[$i]} = hex($exp[$i]);
|
|
}
|
|
|
|
# assign the numbers to interns
|
|
foreach my $field (@fields) {
|
|
next if $field eq "raw";
|
|
$this->{$field} = $pwpol{$field};
|
|
}
|
|
|
|
# convert binary flags to true/false values
|
|
foreach my $bit (keys %flagbits) {
|
|
if($pwpol{raw} & $flagbits{$bit}) {
|
|
$this->{$bit} = 1;
|
|
}
|
|
else {
|
|
$this->{$bit} = 0;
|
|
}
|
|
}
|
|
}
|
|
|
|
|
|
sub encode {
|
|
my($this) = @_;
|
|
|
|
# create the bitmask
|
|
my $mask = 0;
|
|
foreach my $bit (keys %flagbits) {
|
|
if($this->{$bit}) {
|
|
$mask |= $flagbits{$bit};
|
|
}
|
|
}
|
|
|
|
# first 4hex chars for the bitmask of policy flags
|
|
my $raw = sprintf "%04x", $mask;
|
|
|
|
# followed by the number fields
|
|
foreach my $field (@fields) {
|
|
next if $field eq "raw";
|
|
$raw .= sprintf "%03x", $this->{$field};
|
|
}
|
|
|
|
if($raw =~ /^0*$/) {
|
|
return '';
|
|
}
|
|
else {
|
|
return $raw;
|
|
}
|
|
}
|
|
|
|
|
|
|
|
=head1 NAME
|
|
|
|
Crypt::PWSafe3::PasswordPolicy - represent a passwordsafe v3 passwprd policy entry of a record.
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
use Data::Dumper;
|
|
use Crypt::PWSafe3;
|
|
use Crypt::PWSafe3::PasswordPolicy;
|
|
my $record = $vault->getrecord($uuid);
|
|
my $policy = Crypt::PWSafe3::PasswordPolicy->new(raw => $record->pwpol);
|
|
|
|
# print current values
|
|
print Dumper($policy);
|
|
|
|
# print some values
|
|
print $policy->UseEasyVision;
|
|
|
|
# change some of them
|
|
$policy->MaxLength(8);
|
|
$policy->MinSymbols(2);
|
|
|
|
# put back into record
|
|
$record->raw($policy->encode());
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
The following flags can be set (1 = TRUE, 0 = FALSE):
|
|
|
|
- UseLowercase
|
|
- UseUppercase
|
|
- UseDigits
|
|
- UseSymbols
|
|
- UseHexDigits
|
|
- UseEasyVision
|
|
- MakePronounceable
|
|
|
|
The following numerical settings can be tuned:
|
|
|
|
- MaxLength
|
|
- MinLowercase
|
|
- MinUppercase
|
|
- MinDigits
|
|
- MinSymbols
|
|
|
|
All of them can be called as functions, see SYNOPSIS for examples. If called with an argument,
|
|
the value will be changed, otherwise it will just returned.
|
|
|
|
The raw database value can be assigned by using the B<raw> parameter.
|
|
|
|
=head1 SEE ALSO
|
|
|
|
L<Crypt::PWSafe3::Record>
|
|
|
|
=head1 AUTHOR
|
|
|
|
T. Linden <tlinden@cpan.org>
|
|
|
|
=head1 COPYRIGHT
|
|
|
|
Copyright (c) 2011-2013 by T.Linden <tlinden@cpan.org>.
|
|
All rights reserved.
|
|
|
|
=head1 LICENSE
|
|
|
|
This program is free software; you can redistribute it
|
|
and/or modify it under the same terms as Perl itself.
|
|
|
|
|
|
=cut
|
|
|
|
1;
|