unit PasswordStrength;
{ A partial - almost complete -implementation of the zxcvbn password
validator which is generally accepted as a standard in the industry.
It is orginally written by developers of dropbox and under M.I.T.
license,
which means this Pascal version is also M.I.T. licensed.
Pascal version by Thaddy de Koning
Important note from the original developers:
"Despite high theoretical entropy, repeated sequences such as
'abcabcabc' or '123123' are considered low-entropy by the algorithm,
as they drastically reduce the number of guesses required.
These are penalized accordingly in the scoring model."
I personally do not agree and think this needs refinement since a
single repeat in a long password doesn't warrant to drop the score
to one:
My thoughts on improvement (with my background in social science):
While common password scoring models penalize repeating sequences,
this implementation does not (yet) recognize that such repeats may
also arise from legitimate randomness. Thus, a single repetition
should lower the score modestly, rather than invalidating the overall
entropy estimate. This is known as context-aware entropy modeling
in social sciences.
For that, I need a data set, and I have found a good one from:
https://github.com/infinitode/pwlds which is heavily used for
scientific research on passwords.
Hey presto: back to gaussian distribution and standard deviation.
For now, though, I implemented a final check that improves the score
like this: if the entropy is above 80 bits and the score is <= 1 the
score adds 2. Likewise above 90 the score adds 3.
That reflects perceived strength more intuitively, especially to
end users who might otherwise be baffled by a score of 1 paired with
“116 bits of entropy"
This is more of a stop-gap, but already much better.
Thaddy
}
{$mode objfpc}{$H+}
interface
type
TStrengthScore = 0..4;
TPasswordAnalysis = record
Score: TStrengthScore;
Entropy: Double;
Suggestions: String;
CrackTime: String;
end;
function HasRepeatedPattern(const Password: String): Boolean;
function AnalyzePassword(const Password: String): TPasswordAnalysis;
implementation
uses
SysUtils, RegExpr;
const
CommonWords: array[0..5] of String = (
'password', '123456', 'qwerty', 'letmein', 'admin', 'welcome'
);
function IsKeyboardPattern(const password: string): boolean;
const
Layout = 'qwertyuiopasdfghjklzxcvbnm';
// todo azerty et.al.
var
i, j: integer;
begin
Result := False;
for i := 1 to Length(password) - 2 do
begin
for j := 1 to Length(Layout) - 2 do
begin
if (password[i] = Layout[j]) and
(password[i+1] = Layout[j+1]) and
(password[i+2] = Layout[j+2]) then
begin
Result := True;
Exit;
end;
end;
end;
end;
function EntropyEstimate(const Password: String): Double;
var
PoolSize: Integer;
HasLower, HasUpper, HasDigit, HasSymbol: Boolean;
begin
HasLower := Password <> UpperCase(Password);
HasUpper := Password <> LowerCase(Password);
with TRegExpr.Create('\d') do
try
HasDigit := Exec(Password);
finally
Free;
end;
with TRegExpr.Create('[\W_]') do
try
HasSymbol := Exec(Password);
finally
Free;
end;
PoolSize := 0;
if HasLower then Inc(PoolSize, 26);
if HasUpper then Inc(PoolSize, 26);
if HasDigit then Inc(PoolSize, 10);
if HasSymbol then Inc(PoolSize, 32);
if (PoolSize > 0) and (Length(Password) > 0) then
Result := Ln(PoolSize) / Ln(2) * Length(Password)
else
Result := 0;
end;
function ContainsCommonPattern(const Password: String): Boolean;
var
Word: String;
begin
Result := False;
for Word in CommonWords do
if Pos(LowerCase(Word), LowerCase(Password)) > 0 then
Exit(True);
end;
(*
function IsKeyboardPattern(const Password: String): Boolean;
const
Patterns: array[0..3] of String = (
'qwertyuiop', 'asdfghjkl', 'zxcvbnm', '1234567890'
);
var
LowerPass, P: String;
I: Integer;
begin
LowerPass := LowerCase(Password);
Result := False;
for P in Patterns do
for I := 1 to Length(P) - 3 do
if Pos(Copy(P, I, 4), LowerPass) > 0 then
Exit(True);
end;
*)
function HasRepeats(const password: string): boolean;
var
i: integer;
ch: char;
begin
Result := False;
if Length(password) < 2 then Exit;
ch := password[1];
for i := 2 to Length(password) do
begin
if password[i] = ch then
begin
Result := True;
Exit;
end
else
ch := password[i];
end;
end;
function ContainsYearPattern(const Password: String): Boolean;
begin
with TRegExpr.Create('\b(19[5-9]\d|20[0-4]\d|2050)\b') do
try
Result := Exec(Password);
finally
Free;
end;
end;
function CrackTimeEstimate(Entropy: Double): String;
begin
if Entropy < 28 then Result := 'Instantly cracked'
else if Entropy < 36 then Result := 'Few seconds'
else if Entropy < 60 then Result := 'Hours'
else if Entropy < 80 then Result := 'Days'
else if Entropy < 100 then Result := 'Years'
else Result := 'Centuries';
end;
(* no support for backtracking ?
function HasRepeatedPattern(const Password: String): Boolean;
begin
with TRegExpr.Create('(.+)\1{1,}') do
try
Result := Exec(Password);
finally
Free;
end;
end;
*)
{ poor man's replacement }
function HasRepeatedPattern(const password: string): boolean;
var
i, j, len: integer;
pattern: string;
begin
Result := False;
len := Length(password);
for i := 1 to len div 2 do
begin
pattern := Copy(password, 1, i);
j := i + 1;
while (j + i - 1 <= len) and (Copy(password, j, i) = pattern) do
Inc(j, i);
if j > len then
begin
Result := True;
Exit;
end;
end;
end;
function AnalyzePassword(const Password: String): TPasswordAnalysis;
begin
Result.Entropy := EntropyEstimate(Password);
Result.CrackTime := CrackTimeEstimate(Result.Entropy);
if (Length(Password) < 6) or ContainsCommonPattern(Password) then
begin
Result.Score := 0;
Result.Suggestions := 'Password too short or too common.';
Exit;
end;
if IsKeyboardPattern(Password) then
begin
Result.Score := 0;
Result.Suggestions := 'Contains an easy keyboard pattern like "asdf".';
Exit;
end;
if HasRepeatedPattern(Password) or hasrepeats(password) then
begin
Result.Score := 0;
Result.Suggestions := 'Avoid repeated sequences like "abcabc" or "1111".';
Exit;
end;
if ContainsYearPattern(Password) then
Result.Suggestions := 'Avoid using years like "1990" or "2025".';
if Result.Entropy < 36 then
begin
Result.Score := 1;
if Result.Suggestions = '' then
Result.Suggestions := 'Add more variety and length.';
end
else if Result.Entropy < 60 then
begin
Result.Score := 2;
if Result.Suggestions = '' then
Result.Suggestions := 'Consider adding symbols or avoiding patterns.';
end
else if Result.Entropy < 80 then
begin
Result.Score := 3;
if Result.Suggestions = '' then
Result.Suggestions := 'Strong, but could be improved.';
end
else
begin
Result.Score := 4;
if Result.Suggestions = '' then
Result.Suggestions := 'Very strong password.';
end;
end.
WIKI Timeout issues
