mirror of
https://github.com/webmin/webmin.git
synced 2026-05-06 23:30:29 +01:00
a293fff996
Some checks failed
webmin.dev: webmin/webmin / build (push) Has been cancelled
Webmin now uses the bundled QRCode::Encoder implementation by default to generate TOTP QR codes locally and inline, without relying on qr.cgi or external services. This encoder requires Perl 5.24 or newer, so qrencode is no longer included as a recommended package dependency. On older systems where the bundled encoder cannot run, admins can still install qrencode manually to restore QR generation support. Systems old enough to lack Perl 5.24 are typically already well past their supported security lifecycle, so keeping qrencode preinstalled by default is no longer treated as a packaging requirement. When neither option is available, Webmin falls back cleanly to manual TOTP setup using the shared secret. https://github.com/webmin/webmin/issues/2667#issuecomment-4247431279 [no-build]
293 lines
11 KiB
Perl
293 lines
11 KiB
Perl
package QRCode::Encoder::QRSpec;
|
|
use v5.24;
|
|
use warnings;
|
|
use experimental qw< signatures >;
|
|
|
|
use Exporter qw< import >;
|
|
our @EXPORT_OK = qw<
|
|
qrspec_ecc_spec
|
|
qrspec_data_size
|
|
qrspec_ecc_size
|
|
qrspec_width
|
|
qrspec_remainder
|
|
qrspec_min_version
|
|
qrspec_min_version_for
|
|
qrspec_length_indicator
|
|
qrspec_maximum_words
|
|
qrspec_mode_indicator
|
|
qrspec_alignment_patterns
|
|
qrspec_format_pattern
|
|
qrspec_version_pattern
|
|
>;
|
|
our %EXPORT_TAGS = (all => [@EXPORT_OK]);
|
|
|
|
# Liberally taken from libqrencode/qrspec.c, which is distributed with
|
|
# LGPL license
|
|
|
|
sub qrspec_ecc_spec ($version, $level) {
|
|
state $ecc_table = [
|
|
map { _zip_hash([qw< L M Q H >], $_) } (
|
|
# L M Q H
|
|
[[ 1, 0], [ 1, 0], [ 1, 0], [ 1, 0]],
|
|
[[ 1, 0], [ 1, 0], [ 1, 0], [ 1, 0]],
|
|
[[ 1, 0], [ 1, 0], [ 2, 0], [ 2, 0]],
|
|
[[ 1, 0], [ 2, 0], [ 2, 0], [ 4, 0]],
|
|
[[ 1, 0], [ 2, 0], [ 2, 2], [ 2, 2]],
|
|
[[ 2, 0], [ 4, 0], [ 4, 0], [ 4, 0]],
|
|
[[ 2, 0], [ 4, 0], [ 2, 4], [ 4, 1]],
|
|
[[ 2, 0], [ 2, 2], [ 4, 2], [ 4, 2]],
|
|
[[ 2, 0], [ 3, 2], [ 4, 4], [ 4, 4]],
|
|
[[ 2, 2], [ 4, 1], [ 6, 2], [ 6, 2]],
|
|
[[ 4, 0], [ 1, 4], [ 4, 4], [ 3, 8]],
|
|
[[ 2, 2], [ 6, 2], [ 4, 6], [ 7, 4]],
|
|
[[ 4, 0], [ 8, 1], [ 8, 4], [12, 4]],
|
|
[[ 3, 1], [ 4, 5], [11, 5], [11, 5]],
|
|
[[ 5, 1], [ 5, 5], [ 5, 7], [11, 7]],
|
|
[[ 5, 1], [ 7, 3], [15, 2], [ 3, 13]],
|
|
[[ 1, 5], [10, 1], [ 1, 15], [ 2, 17]],
|
|
[[ 5, 1], [ 9, 4], [17, 1], [ 2, 19]],
|
|
[[ 3, 4], [ 3, 11], [17, 4], [ 9, 16]],
|
|
[[ 3, 5], [ 3, 13], [15, 5], [15, 10]],
|
|
[[ 4, 4], [17, 0], [17, 6], [19, 6]],
|
|
[[ 2, 7], [17, 0], [ 7, 16], [34, 0]],
|
|
[[ 4, 5], [ 4, 14], [11, 14], [16, 14]],
|
|
[[ 6, 4], [ 6, 14], [11, 16], [30, 2]],
|
|
[[ 8, 4], [ 8, 13], [ 7, 22], [22, 13]],
|
|
[[10, 2], [19, 4], [28, 6], [33, 4]],
|
|
[[ 8, 4], [22, 3], [ 8, 26], [12, 28]],
|
|
[[ 3, 10], [ 3, 23], [ 4, 31], [11, 31]],
|
|
[[ 7, 7], [21, 7], [ 1, 37], [19, 26]],
|
|
[[ 5, 10], [19, 10], [15, 25], [23, 25]],
|
|
[[13, 3], [ 2, 29], [42, 1], [23, 28]],
|
|
[[17, 0], [10, 23], [10, 35], [19, 35]],
|
|
[[17, 1], [14, 21], [29, 19], [11, 46]],
|
|
[[13, 6], [14, 23], [44, 7], [59, 1]],
|
|
[[12, 7], [12, 26], [39, 14], [22, 41]],
|
|
[[ 6, 14], [ 6, 34], [46, 10], [ 2, 64]],
|
|
[[17, 4], [29, 14], [49, 10], [24, 46]],
|
|
[[ 4, 18], [13, 32], [48, 14], [42, 32]],
|
|
[[20, 4], [40, 7], [43, 22], [10, 67]],
|
|
[[19, 6], [18, 31], [34, 34], [20, 61]],
|
|
)
|
|
];
|
|
|
|
my ($b1, $b2) = $ecc_table->[$version - 1]{$level}->@*;
|
|
my $data_size = qrspec_data_size($version, $level);
|
|
my $ecc_size = qrspec_ecc_size($version, $level);
|
|
my @retval;
|
|
|
|
push @retval, {
|
|
count => $b1,
|
|
data => int($data_size / ($b1 + $b2)),
|
|
ecc => int($ecc_size / ($b1 + $b2)),
|
|
};
|
|
|
|
push @retval, {
|
|
count => $b2,
|
|
data => ($retval[0]{data} + 1),
|
|
ecc => $retval[0]{ecc},
|
|
} if $b2;
|
|
|
|
return @retval;
|
|
}
|
|
|
|
sub qrspec_width ($version) { 17 + $version * 4 }
|
|
|
|
{
|
|
state $table = [
|
|
map { $_->{ec} = _zip_hash([qw< L M Q H >], $_->{ec}); $_ } (
|
|
{ words => 26, remainder => 0, ec => [ 7, 10, 13, 17]},
|
|
{ words => 44, remainder => 7, ec => [ 10, 16, 22, 28]},
|
|
{ words => 70, remainder => 7, ec => [ 15, 26, 36, 44]},
|
|
{ words => 100, remainder => 7, ec => [ 20, 36, 52, 64]},
|
|
{ words => 134, remainder => 7, ec => [ 26, 48, 72, 88]},
|
|
{ words => 172, remainder => 7, ec => [ 36, 64, 96, 112]},
|
|
{ words => 196, remainder => 0, ec => [ 40, 72, 108, 130]},
|
|
{ words => 242, remainder => 0, ec => [ 48, 88, 132, 156]},
|
|
{ words => 292, remainder => 0, ec => [ 60, 110, 160, 192]},
|
|
{ words => 346, remainder => 0, ec => [ 72, 130, 192, 224]},
|
|
{ words => 404, remainder => 0, ec => [ 80, 150, 224, 264]},
|
|
{ words => 466, remainder => 0, ec => [ 96, 176, 260, 308]},
|
|
{ words => 532, remainder => 0, ec => [ 104, 198, 288, 352]},
|
|
{ words => 581, remainder => 3, ec => [ 120, 216, 320, 384]},
|
|
{ words => 655, remainder => 3, ec => [ 132, 240, 360, 432]},
|
|
{ words => 733, remainder => 3, ec => [ 144, 280, 408, 480]},
|
|
{ words => 815, remainder => 3, ec => [ 168, 308, 448, 532]},
|
|
{ words => 901, remainder => 3, ec => [ 180, 338, 504, 588]},
|
|
{ words => 991, remainder => 3, ec => [ 196, 364, 546, 650]},
|
|
{ words =>1085, remainder => 3, ec => [ 224, 416, 600, 700]},
|
|
{ words =>1156, remainder => 4, ec => [ 224, 442, 644, 750]},
|
|
{ words =>1258, remainder => 4, ec => [ 252, 476, 690, 816]},
|
|
{ words =>1364, remainder => 4, ec => [ 270, 504, 750, 900]},
|
|
{ words =>1474, remainder => 4, ec => [ 300, 560, 810, 960]},
|
|
{ words =>1588, remainder => 4, ec => [ 312, 588, 870, 1050]},
|
|
{ words =>1706, remainder => 4, ec => [ 336, 644, 952, 1110]},
|
|
{ words =>1828, remainder => 4, ec => [ 360, 700, 1020, 1200]},
|
|
{ words =>1921, remainder => 3, ec => [ 390, 728, 1050, 1260]},
|
|
{ words =>2051, remainder => 3, ec => [ 420, 784, 1140, 1350]},
|
|
{ words =>2185, remainder => 3, ec => [ 450, 812, 1200, 1440]},
|
|
{ words =>2323, remainder => 3, ec => [ 480, 868, 1290, 1530]},
|
|
{ words =>2465, remainder => 3, ec => [ 510, 924, 1350, 1620]},
|
|
{ words =>2611, remainder => 3, ec => [ 540, 980, 1440, 1710]},
|
|
{ words =>2761, remainder => 3, ec => [ 570, 1036, 1530, 1800]},
|
|
{ words =>2876, remainder => 0, ec => [ 570, 1064, 1590, 1890]},
|
|
{ words =>3034, remainder => 0, ec => [ 600, 1120, 1680, 1980]},
|
|
{ words =>3196, remainder => 0, ec => [ 630, 1204, 1770, 2100]},
|
|
{ words =>3362, remainder => 0, ec => [ 660, 1260, 1860, 2220]},
|
|
{ words =>3532, remainder => 0, ec => [ 720, 1316, 1950, 2310]},
|
|
{ words =>3706, remainder => 0, ec => [ 750, 1372, 2040, 2430]},
|
|
)
|
|
];
|
|
|
|
sub qrspec_data_size ($version, $level) {
|
|
my $item = $table->[$version - 1];
|
|
return $item->{words} - $item->{ec}{$level};
|
|
}
|
|
|
|
sub qrspec_ecc_size ($version, $level) {
|
|
return $table->[$version - 1]{ec}{$level};
|
|
}
|
|
|
|
sub qrspec_remainder ($version) { $table->[$version - 1]{remainder} }
|
|
|
|
sub qrspec_min_version ($size, $level) {
|
|
state $arefs = {};
|
|
|
|
# first run goes through all items in the table, so this function
|
|
# is inefficient if called once per process but gets better when it
|
|
# is used multiple times per process.
|
|
my $aref = $arefs->{$level} //= do {
|
|
[ map { $_->{words} - $_->{ec}{$level} } $table->@* ]
|
|
};
|
|
|
|
# do not bother looking for a version if none is possible
|
|
return if $size > $aref->[-1];
|
|
|
|
# binary search over $aref
|
|
my ($lo, $hi) = (0, $aref->$#*);
|
|
while ($lo < $hi) {
|
|
my $mi = int(($lo + $hi) / 2);
|
|
my $misz = $aref->[$mi];
|
|
if ($misz < $size) { $lo = $mi + 1 } # move ahead
|
|
elsif ($misz == $size) { $lo = $hi = $mi } # exact match
|
|
else { $hi = $mi } # set upper limit
|
|
}
|
|
return $lo + 1;
|
|
}
|
|
}
|
|
|
|
{
|
|
state $table = {
|
|
numeric => '0001',
|
|
alphanumeric => '0010',
|
|
byte => '0100',
|
|
kanji => '1000',
|
|
eci => '0111',
|
|
structured_append => '0011',
|
|
fnc1_1 => '0101',
|
|
fnc1_2 => '1001',
|
|
terminator => '0000',
|
|
};
|
|
sub qrspec_mode_indicator ($mode) { $table->{$mode} }
|
|
}
|
|
|
|
{
|
|
state $table = {
|
|
numeric => [10, 12, 14],
|
|
alphanumeric => [ 9, 11, 13],
|
|
byte => [ 8, 16, 16],
|
|
kanji => [ 8, 10, 12],
|
|
};
|
|
|
|
sub qrspec_min_version_for ($mode, $size, $level) {
|
|
state $size_bits_for = {
|
|
numeric => sub ($s) { 10 * int($s / 3) + [0, 4, 7]->[$s % 3] },
|
|
alphanumeric => sub ($s) { 11 * int($s / 2) + 6 * ($s % 2) },
|
|
byte => sub ($s) { return 8 * $s },
|
|
kanji => sub ($s) { return 13 * $s },
|
|
};
|
|
|
|
my $min_bits = 4 + $size_bits_for->{$mode}->($size);
|
|
my $lengths = $table->{$mode};
|
|
for my $i (0 .. $lengths->$#*) {
|
|
my $n_bits = $min_bits + $lengths->[$i];
|
|
my $rem = $n_bits % 8;
|
|
my $n_words = (($n_bits - $rem) / 8) + ($rem ? 1 : 0);
|
|
my $version = qrspec_min_version($n_words, $level);
|
|
return if !defined($version);
|
|
my $j = $version <= 9 ? 0 : $version <= 26 ? 1 : 2;
|
|
return $version if $i == $j;
|
|
}
|
|
return;
|
|
}
|
|
|
|
sub qrspec_length_indicator ($mode, $version) {
|
|
my $l = $version <= 9 ? 0 : $version <= 26 ? 1 : 2;
|
|
return $table->{$mode}[$l];
|
|
}
|
|
|
|
sub qrspec_maximum_words ($mode, $version) {
|
|
my $l = $version <= 9 ? 0 : $version <= 26 ? 1 : 2;
|
|
my $bits = $table->{$mode}[$l];
|
|
my $words = (1 << $bits) - 1;
|
|
$words *= 2 if $mode eq 'kanji';
|
|
return $words;
|
|
}
|
|
}
|
|
|
|
sub qrspec_format_pattern ($level, $mask_id) {
|
|
state $formats_for = {
|
|
L => [0x77c4, 0x72f3, 0x7daa, 0x789d, 0x662f, 0x6318, 0x6c41, 0x6976],
|
|
M => [0x5412, 0x5125, 0x5e7c, 0x5b4b, 0x45f9, 0x40ce, 0x4f97, 0x4aa0],
|
|
Q => [0x355f, 0x3068, 0x3f31, 0x3a06, 0x24b4, 0x2183, 0x2eda, 0x2bed],
|
|
H => [0x1689, 0x13be, 0x1ce7, 0x19d0, 0x0762, 0x0255, 0x0d0c, 0x083b],
|
|
};
|
|
return $formats_for->{$level}[$mask_id];
|
|
}
|
|
|
|
sub qrspec_version_pattern ($version) {
|
|
state $version_pattern_for = [
|
|
0x07c94, 0x085bc, 0x09a99, 0x0a4d3, # 7-10
|
|
0x0bbf6, 0x0c762, 0x0d847, 0x0e60d, 0x0f928, # 11-15
|
|
0x10b78, 0x1145d, 0x12a17, 0x13532, 0x149a6, # 16-20
|
|
0x15683, 0x168c9, 0x177ec, 0x18ec4, 0x191e1, # 21-25
|
|
0x1afab, 0x1b08e, 0x1cc1a, 0x1d33f, 0x1ed75, # 26-30
|
|
0x1f250, 0x209d5, 0x216f0, 0x228ba, 0x2379f, # 31-35
|
|
0x24b0b, 0x2542e, 0x26a64, 0x27541, 0x28c69, # 36-40
|
|
];
|
|
return $version <= 6 ? undef : $version_pattern_for->[$version - 7];
|
|
}
|
|
|
|
sub qrspec_alignment_patterns ($version) {
|
|
state $base = [
|
|
[18 ], [22 ], [26 ], [30 ], # 2- 5
|
|
[34 ], [22, 38], [24, 42], [26, 46], [28, 50], # 6-10
|
|
[30, 54], [32, 58], [34, 62], [26, 46], [26, 48], # 11-15
|
|
[26, 50], [30, 54], [30, 56], [30, 58], [34, 62], # 16-20
|
|
[28, 50], [26, 50], [30, 54], [28, 54], [32, 58], # 21-25
|
|
[30, 58], [34, 62], [26, 50], [30, 54], [26, 52], # 26-30
|
|
[30, 56], [34, 60], [30, 58], [34, 62], [30, 54], # 31-35
|
|
[24, 50], [28, 54], [32, 58], [26, 54], [30, 58], # 35-40
|
|
];
|
|
state $cache = { 1 => [] };
|
|
my $aref = $cache->{$version} //= do {
|
|
my @offset = (6, $base->[$version - 2]->@*);
|
|
my $width = qrspec_width($version);
|
|
while ('necessary') {
|
|
my $next = 2 * $offset[-1] - $offset[-2];
|
|
last if $next + 2 >= $width;
|
|
push @offset, $next;
|
|
}
|
|
\@offset;
|
|
};
|
|
return $aref->@*;
|
|
}
|
|
|
|
sub _zip_hash ($aref1, $aref2) {
|
|
my %hash;
|
|
@hash{$aref1->@*} = $aref2->@*;
|
|
return \%hash;
|
|
}
|
|
|
|
1;
|