Fix to default TOTP QR generation to QRCode::Encoder

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]

makedebian.pl

@@ -109,7 +109,7 @@ if ($product eq "webmin") {
 $size = int(`du -sk $tmp_dir`);
 @deps = ( "perl", "libnet-ssleay-perl", "openssl", "libauthen-pam-perl", "libpam-runtime", "libio-pty-perl", "unzip", "shared-mime-info", "tar", "libdigest-sha-perl", "libdigest-md5-perl", "gzip" );
 $deps = join(", ", @deps);
-@recommends = ( "libdatetime-perl", "libdatetime-timezone-perl", "libdatetime-locale-perl", "libtime-piece-perl", "libencode-detect-perl", "libtime-hires-perl", "libsocket6-perl", "html2text", "qrencode", "libdbi-perl", "libdbd-mysql-perl", "libdbd-mariadb-perl", "libjson-xs-perl", "libsys-syslog-perl" );
+@recommends = ( "libdatetime-perl", "libdatetime-timezone-perl", "libdatetime-locale-perl", "libtime-piece-perl", "libencode-detect-perl", "libtime-hires-perl", "libsocket6-perl", "html2text", "libdbi-perl", "libdbd-mysql-perl", "libdbd-mariadb-perl", "libjson-xs-perl", "libsys-syslog-perl" );
 $recommends = join(", ", @recommends);
 open(CONTROL, ">$control_file");
 print CONTROL <<EOF;

makerpm.pl

@@ -88,7 +88,7 @@ Release: $rel
 Provides: %{name}-%{version} perl(WebminCore)
 Requires(pre): /usr/bin/perl
 Requires: /bin/sh /usr/bin/perl perl(lib) perl(open) perl(Net::SSLeay) perl(Time::Local) perl(Data::Dumper) perl(File::Path) perl(File::Basename) perl(Digest::SHA) perl(Digest::MD5) openssl unzip tar gzip
-Recommends: perl(DateTime) perl(DateTime::TimeZone) perl(DateTime::Locale) perl(Time::Piece) perl(Encode::Detect) perl(Time::HiRes) perl(Socket6) perl(Sys::Syslog) html2text shared-mime-info lsof perl-File-Basename perl-File-Path perl-JSON-XS qrencode perl(DBI) perl(DBD::mysql) perl(DBD::MariaDB)
+Recommends: perl(DateTime) perl(DateTime::TimeZone) perl(DateTime::Locale) perl(Time::Piece) perl(Encode::Detect) perl(Time::HiRes) perl(Socket6) perl(Sys::Syslog) html2text shared-mime-info lsof perl-File-Basename perl-File-Path perl-JSON-XS perl(DBI) perl(DBD::mysql) perl(DBD::MariaDB)
 AutoReq: 0
 License: BSD-3-Clause
 Group: System/Tools

vendor_perl/Math/ReedSolomon/Encoder.pm

@@ -0,0 +1,117 @@
+# Liberally adapted from:
+# https://en.wikiversity.org/wiki/Reed%E2%80%93Solomon_codes_for_coders
+
+package Math::ReedSolomon::Encoder;
+use v5.24;
+use warnings;
+use experimental qw< signatures >;
+{ our $VERSION = '0.001' }
+
+use Exporter qw< import >;
+our @EXPORT_OK = qw<
+   rs_correction
+   rs_correction_string
+   rs_encode
+   rs_encode_string
+>;
+our %EXPORT_TAGS = (all => [ @EXPORT_OK ]);
+
+our $ALPHA = 2;
+our $PRIME_POLY = 0X11D;
+
+########################################################################
+#
+# Public Interface
+
+sub rs_correction ($msg, $nsym) {
+   my $g = _rs_generator_poly($nsym);
+   my ($quot, $rem) = _gf256_poly_div([$msg->@*, (0) x $nsym ], $g);
+   return $rem;
+}
+
+sub rs_correction_string ($msg, $nsym) {
+   my $aref = [ map { ord($_) } split m{}mxs, $msg ];
+   return join '', map { chr($_) } rs_correction($aref, $nsym)->@*;
+}
+
+sub rs_encode ($msg, $nsym) {
+   return [ $msg->@*, rs_correction($msg, $nsym)->@* ];
+}
+
+sub rs_encode_string ($msg, $nsym) {
+   return $msg . rs_correction_string($msg, $nsym);
+}
+
+
+########################################################################
+#
+# Private Interface
+
+sub _rs_generator_poly ($nsym) {
+   state $gs = [ [1] ];
+   push $gs->@*, _gf256_poly_mul($gs->[-1], [1, _gf256_pow($ALPHA, $gs->$#*)])
+      while $nsym > $gs->$#*;
+   return $gs->[$nsym];
+}
+
+sub _gf256_table_for {
+   state $table_for = do {
+      my (@exp, @log);
+      my $x = 1;
+      for my $i (0 .. 254) {
+         $exp[$i] = $exp[$i + 255] = $x;
+         $log[$x] = $i;
+         $x <<= 1;
+         $x ^= $PRIME_POLY if $x & 0x100;
+      }
+      { exp => \@exp, log => \@log };
+   };
+}
+
+sub _gf256_mul ($x, $y) {
+   state $table_for = _gf256_table_for();
+   state $exp = $table_for->{exp};
+   state $log = $table_for->{log};
+   return 0 if $x == 0 || $y == 0;
+   return $exp->[$log->[$x] + $log->[$y]];
+}
+
+sub _gf256_pow ($x, $pow) {
+   state $table_for = _gf256_table_for();
+   state $exp = $table_for->{exp};
+   state $log = $table_for->{log};
+   return $exp->[($log->[$x] * $pow) % 255];
+}
+
+sub _gf256_poly_mul ($p, $q) {
+   my $lp = $p->@*;
+   my $lq = $q->@*;
+   my $lr = $lp + $lq - 1;
+   my $r = [ (0) x $lr ];
+   for my $i (0 .. ($lp - 1)) {
+      for my $j (0 .. ($lq - 1)) {
+         $r->[$i + $j] ^= _gf256_mul($p->[$i], $q->[$j]);
+      }
+   }
+   return $r;
+}
+
+sub _gf256_poly_div ($x, $y) {
+   my $retval = [ $x->@* ];
+   for my $i (0 .. ($x->$#* - $y->$#*)) {
+      my $c = $retval->[$i];
+      if ($c != 0) {
+         for my $j (1 .. $y->$#*) {
+            if ($y->[$j] != 0) {
+               $retval->[$i + $j] ^= _gf256_mul($y->[$j], $c);
+            }
+         }
+      }
+   }
+   my $separator = $retval->$#* - $y->$#*;
+   my $quot = [ $retval->@[0 .. $separator] ];
+   my $rem  = [ $retval->@[$separator + 1 .. $retval->$#*] ];
+   return ($quot, $rem);
+}
+
+1;

vendor_perl/QRCode/Encoder.pm

@@ -0,0 +1,252 @@
+package QRCode::Encoder;
+use v5.24;
+use warnings;
+use experimental qw< signatures >;
+{ our $VERSION = '0.005' }
+
+use Math::ReedSolomon::Encoder qw< rs_correction_string >;
+use QRCode::Encoder::QRSpec qw< :all >;
+use QRCode::Encoder::Matrix qw< add_matrix >;
+use Exporter qw< import >;
+our @EXPORT_OK = qw<
+   qr_best_params
+   qr_encode
+   qr_mode
+>;
+our %EXPORT_TAGS = (all => [ @EXPORT_OK ]);
+
+sub qr_mode ($octets) {
+   return 'numeric' if $octets =~ m{\A \d* \z}mxs;
+   return 'alphanumeric'
+      if $octets =~ m{\A [0-9A-Z\x20\x24\x25\x2a\x2b\x2d-\x2f\x3a]+ \z}mxs;
+   return 'kanji'
+      if $octets =~ m{\A
+         (?:  # start of a pair
+               (?: [\x81-\x9f\xe0-\xea] [\x40-\x7e\x80-\xfc])
+            |  (?: \xeb [\x40-\x7e\x80\xbf])
+         )+
+      \z}mxs;
+   return 'byte';
+}
+
+sub qr_best_params (@args) {
+   state $rank_for = { L => 1, M => 2, Q => 3, H => 4 };
+   my %args = scalar(@args) % 2 ? (octets => @args) : @args;
+   my $size = length($args{octets});
+   my $mode = $args{mode} // qr_mode($args{octets});
+
+   my $version = $args{version};
+   my $min_version = $args{'min-version'} // 1;
+   $version //= 40 if $min_version eq 40;
+
+   my $level = $args{level};
+   my $min_level = $args{min_level} // 'L';
+   $level //= 'H' if $min_level eq 'H';
+
+   if (defined($level)) {
+      my $minv = qrspec_min_version_for($mode, $size, $level)
+         or die "no suitable version for $mode/$size/$level";
+      if (defined($version)) { # just check
+         die "version $version insufficient for $mode/$size/$level"
+            if $version < $minv;
+      }
+      else {
+         my $req = $args{min_version} // 1;
+         $version =  $minv < $req ? $req : $minv;
+      }
+   }
+   elsif (defined($version)) {
+      my $min_rank = $rank_for->{$min_level};
+      for my $candidate (qw< H Q M L >) {
+         last if $rank_for->{$candidate} < $min_rank;
+         my $minv = qrspec_min_version_for($mode, $size, $candidate);
+         if ($minv <= $version) {
+            $level = $candidate;
+            last;
+         }
+      }
+      die "no level for $mode/$size/$version (min rank: $min_rank)"
+         unless defined $level;
+   }
+   else { # nothing is defined, go for the smaller size
+      $level = $min_level;
+      my $min_rank = $rank_for->{$level};
+      my $minv = qrspec_min_version_for($mode, $size, $level);
+      my $req = $args{'min-version'} // 1;
+      $version = $minv <= $req ? $req : $minv;
+      for my $candidate (qw< L M Q H >) {
+         next if $rank_for->{$candidate} <= $min_rank;
+         my $altv = qrspec_min_version_for($mode, $size, $candidate);
+         last if $altv > $minv;
+         $level = $candidate;
+      }
+   }
+
+   return (
+      %args,
+      mode    => $mode,
+      level   => $level,
+      version => $version,
+   );
+}
+
+sub qr_encode (@args) {
+   my %args = qr_best_params(@args);
+   my $mode = $args{mode};
+   my $level = $args{level};
+   my $size = length($args{octets});
+   $args{version} //= qrspec_min_version_for($mode, $size, $level);
+   _add_encoded(\%args);
+   _add_codewords(\%args);
+   _add_error_correction(\%args);
+   add_matrix(\%args);
+   _add_plot(\%args);
+   return \%args;
+}
+
+sub _add_plot ($args) {
+   $args->{plot} = [
+      map { [ map { $_ & 0x01 ? '*' : ' ' } $_->@* ] } $args->{matrix}->@*
+   ];
+   return $args;
+}
+
+sub _add_encoded ($args) {
+   state $encoder_for = {
+      numeric => \&_qr_encode_numeric,
+      alphanumeric => \&_qr_encode_alphanumeric,
+      byte => \&_qr_encode_byte,
+      kanji => \&_qr_encode_kanji,
+   };
+
+   my $mode = $args->{mode};
+   my $encoder = $encoder_for->{$mode} or die "missing mode <$mode>\n";
+   my $mi = qrspec_mode_indicator($mode);
+
+   my $version = $args->{version};
+   my $size = length($args->{octets});
+
+   my $lis = qrspec_length_indicator($mode, $args->{version});
+   my $li = _dec2bin(length($args->{octets}), $lis);
+
+   $args->{encoded} = $mi . $li . $encoder->($args->{octets});
+
+   return $args;
+}
+
+sub _add_codewords ($args) {
+   my $bit_stream = $args->{encoded};
+   my $data_size = qrspec_data_size($args->@{qw< version level >});
+   my $needed_bits = length($bit_stream);
+   my $residual_bits = 8 * $data_size - $needed_bits;
+   die "not enough bits, wrong version?\n" if $residual_bits < 0;
+   my $terminator_size = $residual_bits >= 4 ? 4 : $residual_bits;
+   $bit_stream .= '0' x $terminator_size;
+   $residual_bits -= $terminator_size;
+   if (my $pad1 = $residual_bits % 8) {
+      $bit_stream .= '0' x $pad1;
+      $residual_bits -= $pad1;
+   }
+   while ($residual_bits > 0) {
+      $bit_stream .= '11101100';
+      last if $residual_bits == 8;
+      $bit_stream .= '00010001';
+      $residual_bits -= 16;
+   }
+   $args->{bit_stream} = $bit_stream;
+   $args->{codewords} = pack 'B*', $bit_stream;
+   return $args;
+}
+
+sub _add_error_correction ($args) {
+   my @blocks = qrspec_ecc_spec($args->@{qw< version level >});
+   $args->{ecc} = \@blocks;
+   my $expanded = '';
+   my $codewords = $args->{codewords};
+   my $i = 0;
+   my (@codewords, @eccs);
+   for my $block (@blocks) {
+      my ($ecc, $data, $count) = $block->@{qw< ecc data count >};
+      while ($count-- > 0) {
+         my $cw = substr($codewords, $i, $data);
+         push @codewords, $cw;
+         push @eccs, rs_correction_string($cw, $ecc);
+         $i += $data;
+      }
+   }
+   $args->{expanded} = _linearize(\@codewords) . _linearize(\@eccs);
+   $args->{remainder} = qrspec_remainder($args->{version});
+   return $args;
+}
+
+sub _linearize ($strings) {
+   return $strings->[0] if $strings->@* == 1;
+   my $retval = '';
+   my $i = 0;
+   my $n = length($strings->[-1]);
+   while ($i < $n) {
+      for my $string ($strings->@*) {
+         next if $i >= length($string);
+         $retval .= substr($string, $i, 1);
+      }
+      ++$i;
+   }
+   return $retval;
+}
+
+sub _dec2bin ($v, $n) { substr(unpack('B*', pack('N', $v)), -$n, $n) }
+
+sub _qr_encode_numeric ($octets) {
+   state $n_bits_for = [ 4, 7, 10 ];
+   my $i = 0; # index of start of substr, advanced each iteration
+   my $r = length($octets); # number of residual octets to take
+   my $bits = '';
+   while ($r > 0) {
+      my $l = $r >= 3 ? 3 : $r;
+      $bits .= _dec2bin(substr($octets, $i, $l), $n_bits_for->[$l - 1]);
+      $r -= $l;
+      $i += $l;
+   }
+   return $bits;
+}
+
+sub _qr_encode_alphanumeric ($octets) {
+   state $chars = [ 0 .. 9, 'A' .. 'Z', split //, ' $%*+-./:' ];
+   state $value_for = { map { $chars->[$_] => $_ } 0 .. $chars->$#* };
+   my $i = 0; # index of start of substr, advanced each iteration
+   my $r = length($octets); # number of residual octets to take
+   my $bits = '';
+   while ($r > 0) {
+      if ($r == 1) {
+         $bits .= _dec2bin($value_for->{substr($octets, $i, 1)}, 6);
+         $r = 0;
+      }
+      else {
+         my $value = $value_for->{substr($octets, $i++, 1)} * 45;
+         $value += $value_for->{substr($octets, $i++, 1)};
+         $bits .= _dec2bin($value, 11);
+         $r -= 2;
+      }
+   }
+   return $bits;
+}
+
+sub _qr_encode_kanji ($octets) {
+   my $i = 0;
+   my $r = length($octets);
+   my $bits = '';
+   while ($r > 0) {
+      my $v = unpack('n', substr($octets, $i, 2));
+      $v -= ($v <= 0x9FFC) ? 0x8140 : 0xC140;
+      $v = ($v >> 8) * 0xC0 + ($v & 0xFF);
+      $bits .= _dec2bin($v, 13);
+      $r -= 2;
+      $i += 2;
+   }
+   return $bits;
+}
+
+sub _qr_encode_byte ($octets) { unpack 'B*', $octets }
+
+
+1;

vendor_perl/QRCode/Encoder/Matrix.pm

@@ -0,0 +1,394 @@
+package QRCode::Encoder::Matrix;
+use v5.24;
+use experimental qw< signatures >;
+use List::Util qw< sum >;
+use QRCode::Encoder::QRSpec qw<
+   qrspec_version_pattern
+   qrspec_format_pattern
+   qrspec_alignment_patterns
+>;
+
+use Exporter qw< import >;
+our @EXPORT_OK = qw< add_matrix >;
+
+# Parts liberally taken from libqrencode/qrspec.c, which is distributed
+# with LGPL license
+
+sub add_matrix ($data) {
+   add_base_matrix($data);
+   add_quiet($data);
+   add_finders($data);
+   add_format_reservations($data);   # MUST: before add_timing
+   add_version($data);
+   add_timing($data);
+   add_alignments($data);
+   add_codewords($data);
+   add_mask($data);
+   return $data;
+}
+
+sub stringify_matrix ($data) {
+   my @chunks;
+   my $matrix = $data->{matrix};
+   for my $row ($matrix->@*) {
+      push @chunks, join '', map { chr($_) } $row->@*;
+   }
+   return join "\n", @chunks;
+}
+
+sub stringify_matrix_2 ($data) {
+   my @chunks;
+   my $matrix = $data->{matrix};
+   for my $row ($matrix->@*) {
+      push @chunks, join '', map { ($_ & 0x1) ? '#' : ' ' } $row->@*;
+   }
+   return join "\n", @chunks;
+}
+
+sub add_base_matrix ($data) {
+   my $side = $data->{side_size} = 17 + 4 * $data->{version};
+   my $eside = $data->{eside_size} = $side + 8;
+   $data->{matrix} = [ map { [ ( 0x38 ) x $eside ] } 1 .. $eside ];
+   return $data;
+}
+
+sub add_finders ($data) {
+   my $eside_size = $data->{eside_size};
+   add_finder($data, 4 - 1, 4 - 1);
+   add_finder($data, 4 - 1, $eside_size - 8 - 4);
+   add_finder($data, $eside_size - 8 - 4, 4 - 1);
+   return $data;
+}
+
+sub add_quiet ($data) {
+   my $es = $data->{eside_size};
+   my $matrix = $data->{matrix};
+   for my $i (0 .. 3) {
+      for my $j (0 .. $es - 1) {
+         $matrix->[$i][$j] =
+         $matrix->[$es - 1 - $i][$j] =
+         $matrix->[$j][$i] =
+         $matrix->[$j][$es - 1 - $i] = 0x30;
+      }
+   }
+   return $data;
+}
+
+sub add_finder ($data, $x, $y) {
+   state $shape = [
+      [  0x30, 0x30, 0x30, 0x30, 0x30, 0x30, 0x30, 0x30, 0x30 ],
+      [  0x30, 0x31, 0x31, 0x31, 0x31, 0x31, 0x31, 0x31, 0x30 ],
+      [  0x30, 0x31, 0x30, 0x30, 0x30, 0x30, 0x30, 0x31, 0x30 ],
+      [  0x30, 0x31, 0x30, 0x31, 0x31, 0x31, 0x30, 0x31, 0x30 ],
+      [  0x30, 0x31, 0x30, 0x31, 0x31, 0x31, 0x30, 0x31, 0x30 ],
+      [  0x30, 0x31, 0x30, 0x31, 0x31, 0x31, 0x30, 0x31, 0x30 ],
+      [  0x30, 0x31, 0x30, 0x30, 0x30, 0x30, 0x30, 0x31, 0x30 ],
+      [  0x30, 0x31, 0x31, 0x31, 0x31, 0x31, 0x31, 0x31, 0x30 ],
+      [  0x30, 0x30, 0x30, 0x30, 0x30, 0x30, 0x30, 0x30, 0x30 ],
+   ];
+   my $matrix = $data->{matrix};
+   for my $yoff (0 .. 8) {
+      my $Y = $y + $yoff;
+      for my $xoff (0 .. 8) {
+         my $X = $x + $xoff;
+         $matrix->[$Y][$X] = $shape->[$yoff][$xoff];
+      }
+   }
+   return $data;
+}
+
+sub add_format_reservations ($data) {
+   my $matrix = $data->{matrix};
+   my $es = $data->{eside_size};
+   for my $i (0 .. 7) {
+      $matrix->[12][$i + 4] =
+      $matrix->[12][$i + $es - 4 - 8] =
+      $matrix->[$i + $es - 4 - 8][12] =
+      $matrix->[$i + 4][12] = 0x32;
+   }
+   $matrix->[12][12] = 0x32;
+   $matrix->[$es - 4 - 8][12] = 0x31;
+   return $data;
+}
+
+sub add_version_reservations ($data) {
+   return $data->{version} <= 6;
+
+   my $matrix = $data->{matrix};
+   my $ecstart = $data->{eside_size} - 4 - 7 - 4;
+   for my $i (4 .. 9) {
+      for my $j ($ecstart .. ($ecstart + 2)) {
+         $matrix->[$i][$j] = $matrix->[$j][$i] = 0x32;
+      }
+   }
+
+   return $data;
+}
+
+sub add_timing ($data) {
+   my $matrix = $data->{matrix};
+   my $es = $data->{eside_size};
+   for my $i (12 .. ($es - 4 - 8 - 1)) {
+      $matrix->[$i][10] = $matrix->[10][$i] = 0x35 ^ ($i & 1);
+   }
+   return $data;
+}
+
+sub try_add_alignment_pattern ($data, $x, $y) {
+   state $shape = [
+      [  0x31, 0x31, 0x31, 0x31, 0x31 ],
+      [  0x31, 0x30, 0x30, 0x30, 0x31 ],
+      [  0x31, 0x30, 0x31, 0x30, 0x31 ],
+      [  0x31, 0x30, 0x30, 0x30, 0x31 ],
+      [  0x31, 0x31, 0x31, 0x31, 0x31 ],
+   ];
+   $x += 4; # offset by quiet zone
+   $y += 4; # offset by quiet zone
+   my $matrix = $data->{matrix};
+   return if $matrix->[$y][$x] < 0x34
+      || $matrix->[$y][$x + 4] < 0x34
+      || $matrix->[$y + 4][$x] < 0x34;
+   for my $i (0 .. 4) {
+      for my $j (0 .. 4) {
+         $matrix->[$y + $i][$x + $j] = $shape->[$i][$j];
+      }
+   }
+}
+
+sub add_alignments ($data) {
+   my @offset = qrspec_alignment_patterns($data->{version});
+   for my $y_center (@offset) {
+      for my $x_center (@offset) {
+         try_add_alignment_pattern($data, $x_center - 2, $y_center - 2);
+      }
+   }
+   return $data;
+}
+
+sub bits_iterator ($data) {
+   my $n_expanded = length($data->{expanded});
+   my $rem = $data->{remainder};
+   my $i = 0;
+   my @queue;
+   return sub {
+      if (! @queue) {
+         if ($i < $n_expanded) {
+            push @queue, split m{}mxs, unpack 'B*', substr($data->{expanded}, $i++, 1);
+         }
+         else {
+            push @queue, ('0') x $rem;
+            $rem = 0;
+         }
+      }
+      return shift(@queue);
+   };
+}
+
+sub add_codewords ($data) {
+   my $it = bits_iterator($data);
+   my $matrix = $data->{matrix};
+   my $side_size = $data->{side_size};
+
+   # start from a fake position that would be the last bit of a
+   # hypothetical "-1" codeword
+   my $x = $side_size - 2;
+   my $y = $side_size;
+   my $left = 1;
+   my $d = -1; # direction
+   while (defined(my $bit = $it->())) {
+      while ('necessary') {
+         if ($x % 2 == $left) {
+            ++$x;
+            $y += $d;
+         }
+         else {
+            --$x;
+         }
+         if ($d < 0 && $y < 0) { # reset condition
+            $x -= 2;
+            $y = 0;
+            $d = 1;
+         }
+         elsif ($d > 0 && $y >= $side_size) { # other reset condition
+            $x -= 2;
+            $y = $side_size - 1;
+            $d = -1;
+         }
+         if ($x == 6) { # left timing column, skip a column entirely
+            $x = 5;
+            $left = 0;
+         }
+         last if $matrix->[$y + 4][$x + 4] > 0x37;  # found suitable position
+      }
+      $matrix->[$y + 4][$x + 4] = $bit ? 0x37 : 0x36;
+   }
+   return $data;
+}
+
+sub evaluate_matrix ($matrix) {
+   return 0
+      + evaluate_matrix_adjacents_and_11311($matrix)
+      + evaluate_matrix_blocks($matrix)
+      + evaluate_matrix_proportion($matrix);
+}
+
+sub __row ($matrix, $i) {
+   my $max_idx = $matrix->[0]->$#* - 4;
+   join('', map { $matrix->[$i + 4][$_] & 0x01 ? 1 : 0 } 4 .. $max_idx);
+}
+
+sub __col ($matrix, $i) {
+   my $max_idx = $matrix->[0]->$#* - 4;
+   join('', map { $matrix->[$_][$i + 4] & 0x01 ? 1 : 0 } 4 .. $max_idx);
+}
+
+sub evaluate_matrix_adjacents_and_11311 ($matrix) {
+   my $side_size = $matrix->[0]->@* - 8;
+   my $penalty = 0;
+   my $penalty2 = 0;
+   for my $i (0 .. ($side_size - 1)) {
+      for my $seq (__row($matrix, $i), __col($matrix, $i)) {
+
+         # adjacences
+         my @contributions =
+            map  { $_ -  2 }
+            grep { $_ >= 5 }
+            map  { length  }
+            split m{(0+)}mxs, $seq;
+         $penalty += sum(@contributions) if @contributions;
+
+         # 000011311 | 113110000
+         my @matches = $seq =~ m{
+            (
+                 (?: (?<=0000) 1011101           )  # look behind...
+               | (?:           1011101 (?=0000)  )  # or look ahead
+            )
+         }gmxs;
+         $penalty2 += 40 * scalar(@matches);
+
+      }
+   }
+   return $penalty + $penalty2;
+}
+
+sub evaluate_matrix_blocks ($matrix) {
+   my $side_size = $matrix->[0]->@* - 8;
+   my $penalty = 0;
+   for my $i (0 .. ($side_size - 2)) {
+      for my $j (0 .. ($side_size - 2)) {
+         my $count = 0;
+         for my $offset ([0, 0], [0, 1], [1, 0], [1, 1]) {
+            my ($oi, $oj) = $offset->@*;
+            $count++ if $matrix->[$i + $oi + 4][$j + $oj + 4] & 1;
+         }
+         $penalty += 3 if ($count == 0) || ($count == 4);
+      }
+   }
+   return $penalty;
+}
+
+sub evaluate_matrix_proportion ($matrix) {
+   my $count = sum( map { map { $_ & 0x1 ? 1 : 0 } $_->@* } $matrix->@* );
+   my $side_size = $matrix->[0]->@* - 8;
+   my $total = $side_size * $side_size;
+   my $percentage = 100 * $count / $total;
+   my $deviation = abs($percentage - 50);
+   my $penalty = 10 * int($deviation / 5);
+   return $penalty;
+}
+
+sub masked_matrix ($data, $mask_id) {
+   state $mask_for = {
+      0 => sub ($i, $j) { (($i + $j) % 2) == 0 },
+      1 => sub ($i, $j) { ($i % 2) == 0 },
+      2 => sub ($i, $j) { ($j % 3) == 0 },
+      3 => sub ($i, $j) { (($i + $j) % 3) == 0 },
+      4 => sub ($i, $j) { ((int($i / 2) + int($j / 3)) % 2) == 0 },
+      5 => sub ($i, $j) { ((($i * $j) % 2) + (($i * $j) % 3)) == 0 },
+      6 => sub ($i, $j) { (((($i * $j) % 2) + (($i * $j) % 3)) % 2) == 0 },
+      7 => sub ($i, $j) { (((($i + $j) % 2) + (($i * $j) % 3)) % 2) == 0 },
+   };
+   my $matrix = $data->{matrix};
+   my @masked;
+   my $eside_size = $data->{eside_size};
+   my $mask = $mask_for->{$mask_id};
+   for my $i (0 .. ($eside_size - 1)) {
+      for my $j (0 .. ($eside_size - 1)) {
+         if (($matrix->[$i][$j] >= 0x36) && $mask->($i - 4, $j - 4)) {
+            $masked[$i][$j] = $matrix->[$i][$j] ^ 0x01;
+         }
+         else {
+            $masked[$i][$j] = $matrix->[$i][$j];
+         }
+      }
+   }
+   return \@masked;
+}
+
+sub add_mask ($data) {
+   my ($best_mask_id, $best_matrix, $best_penalty);
+   $data->{masked} = \my @masked;
+   for my $mask_id (0 .. 7) {
+      my $matrix = masked_matrix($data, $mask_id);
+      add_format($matrix, $data->{level}, $mask_id);
+      push @masked, $matrix;
+      my $penalty = evaluate_matrix($matrix);
+      ($best_mask_id, $best_matrix, $best_penalty) = ($mask_id, $matrix, $penalty)
+         if (! $best_matrix) || $penalty < $best_penalty;
+   }
+   $data->{original_matrix} = delete($data->{matrix});
+   $data->{matrix} = $best_matrix;
+   $data->{mask_id} = $best_mask_id;
+   return $data;
+}
+
+sub add_format ($matrix, $level, $mask_id) {
+   my $fmt = qrspec_format_pattern($level, $mask_id);
+   my $es = $matrix->[0]->@*;
+
+   # 1st copy
+   my $format = $fmt;
+   for my $i (0 .. 7) {
+      $matrix->[12][$es - 1 - 4 - $i] = $format & 0x01 ? 0x31 : 0x30;
+      $format >>= 1;
+   }
+   for my $i (8 .. 14) {
+      $matrix->[$es - 1 - 4 - 14 + $i][12] = $format & 0x01 ? 0x31 : 0x30;
+      $format >>= 1;
+   }
+
+   # 2nd copy
+   $format = $fmt;
+   for my $i (0 .. 5) {
+      $matrix->[4 + $i][12] = $format & 0x01 ? 0x31 : 0x30;
+      $format >>= 1;
+   }
+   for my $i (6, 7) {
+      $matrix->[4 + 1 + $i][12] = $format & 0x01 ? 0x31 : 0x30;
+      $format >>= 1;
+   }
+   # 8
+   $matrix->[4 + 1 + 7][11] = $format & 0x01 ? 0x31 : 0x30;
+   $format >>= 1;
+   for my $i (9 .. 14) {
+      $matrix->[4 + 1 + 7][9 + 9 - $i] = $format & 0x01 ? 0x31 : 0x30;
+      $format >>= 1;
+   }
+
+   return $matrix;
+}
+
+sub add_version ($data) {
+   my $vp = qrspec_version_pattern($data->{version}) // return;
+   my $matrix = $data->{matrix};
+   my $ecstart = $data->{eside_size} - 4 - 7 - 4;
+   for my $i (4 .. 9) {
+      for my $j ($ecstart .. ($ecstart + 2)) {
+         $matrix->[$i][$j] = $matrix->[$j][$i] = 0x30 ^ ($vp & 1);
+         $vp >>= 1;
+      }
+   }
+   return $data;
+}
+
+1;

vendor_perl/QRCode/Encoder/QRSpec.pm

@@ -0,0 +1,292 @@
+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;

webmin/lang/en

@@ -1209,6 +1209,7 @@ twofactor_enrolllink=You can now enroll for two-factor authentication in the <a
 twofactor_url=To learn more about $1, see its website at <a href='$2' target=_blank>$2</a>.
 twofactor_etotpmodule=The Perl module <tt>$1</tt> needed for two-factor authentication is not installed. Use the <a href='$2'>Perl Modules</a> page in Webmin to install it.
 twofactor_qrcode=Enter the secret code $1 in the TOTP app, or scan the QR code below.
+twofactor_qrcode_manual=Enter the secret code $1 in the TOTP app and set it up manually, as QR code generation is not supported on this system.
 twofactor_etotpid=Invalid TOTP base32-encoded secret
 twofactor_etotptoken=TOTP token must be a number
 twofactor_etotpmatch=Incorrect OTP code

webmin/qr.cgi

@@ -1,20 +0,0 @@
-#!/usr/local/bin/perl
-# Show a QR code based on parameters
-
-use strict;
-use warnings;
-no warnings 'redefine';
-no warnings 'uninitialized';
-$main::no_acl_check = 1;
-require './webmin-lib.pl';
-
-our (%in, %text, %gconfig, %config);
-&ReadParse();
-&error_setup($text{'qr_err'});
-
-$in{'str'} || &error($text{'qr_estr'});
-my ($img, $mime) = &generate_qr_code($in{'str'}, $in{'size'});
-$img || &error($mime);
-
-&PrintHeader(undef, $mime);
-print $img;

webmin/twofactor-funcs-lib.pl

@@ -224,55 +224,25 @@ sub message_twofactor_totp
 my ($user) = @_;
 my $name = &get_display_hostname()." (".$user->{'name'}.")";
 my $str = "otpauth://totp/".$name."?secret=".$user->{'twofactor_id'};
-my $qrcode = &ui_tag('p',
-	&text('twofactor_qrcode', "<tt>$user->{'twofactor_id'}</tt>"));
-if (&can_generate_qr()) {
-	my $url;
-	if (&get_product_name() eq 'usermin') {
-		$url = "qr.cgi?size=6";
-		}
-	else {
-		$url = "$gconfig{'webprefix'}/webmin/qr.cgi?size=6";
-		}
-	my $id = "twofactor_qr_".int(time())."_".int(rand(1000000));
+my ($qrimg, $mime) = &generate_qr_code($str, 6);
+if ($qrimg) {
+	my $qrcode = &ui_tag('p',
+		&text('twofactor_qrcode', "<tt>$user->{'twofactor_id'}</tt>"));
+	my $src = "data:$mime;base64,".&encode_base64($qrimg, 'noeol');
 	my $img = &ui_tag('img', undef,
-		{ 'id' => $id, 'border' => 0,
-		  'style' => 'width:210px; height:210px; '.
+		{ 'src' => $src, 'border' => 0,
+		  'style' => 'width:180px; height:180px; '.
 		  	     'border:1px solid #444;',
 		  'alt' => 'QR code' });
-	my $id_js = &quote_javascript($id);
-	my $url_js = &quote_javascript($url);
-	my $str_js = &quote_javascript($str);
 	return <<EOF;
-	$qrcode$img
-<script>
-(function() {
-const img = document.getElementById("$id_js"),
-      body = "str=" + encodeURIComponent("$str_js");
-fetch("$url_js", {
-	method: "POST",
-	body: body
-	}).then(function(response) {
-		if (!response.ok) { return null; }
-		return response.blob();
-	}).then(function(blob) {
-		if (!blob) { return; }
-		const reader = new FileReader();
-		reader.onloadend = function() { img.src = reader.result; };
-		reader.readAsDataURL(blob);
-	}).catch(function() { });
-})();
-</script>
-<p>
+	$qrcode$img<p>
 EOF
 	}
 else {
-	my $url = "https://api.qrserver.com/v1/create-qr-code/?".
-		  "size=200x200&data=".&urlize($str);
-	my $img = &ui_tag('img', undef,
-		{ 'src' => $url, 'border' => 0, 'alt' => 'QR code' });
 	return <<EOF;
-	$qrcode$img<p>
+	<p>@{[ &text('twofactor_qrcode_manual',
+		     "<tt>$user->{'twofactor_id'}</tt>") ]}</p>
+	<p>
 EOF
 	}
 }
@@ -361,18 +331,13 @@ if (!$found && $prov) {
 &unlock_file($miniserv->{'twofactorfile'});
 }
 
-# can_generate_qr()
-# Returns 1 if QR codes can be generated on this system
-sub can_generate_qr
+# can_generate_qr_encoder()
+# Returns 1 if the local QRCode::Encoder fallback can be used
+sub can_generate_qr_encoder
 {
-if (&has_command("qrencode")) {
-	return 1;
-	}
-eval "use Image::PNG::QRCode";
-if (!$@) {
-	return 1;
-	}
-return 0;
+eval "use lib (\"$root_directory/vendor_perl\")";
+eval "use QRCode::Encoder qw(qr_encode)";
+return $@ ? 0 : 1;
 }
 
 # generate_qr_code(string, [block-size])
@@ -380,6 +345,10 @@ return 0;
 sub generate_qr_code
 {
 my ($str, $size) = @_;
+if (&can_generate_qr_encoder()) {
+	my @rv = eval { &generate_qr_code_encoder($str, $size) };
+	return @rv if (!$@ && defined($rv[0]));
+	}
 if (&has_command("qrencode")) {
 	# Use the qrencode shell command
 	my $cmd = "qrencode -o - -t PNG ".quotemeta($str);
@@ -391,19 +360,43 @@ if (&has_command("qrencode")) {
 		}
 	return ($out, "image/png");
 	}
-eval "use Image::PNG::QRCode";
-if (!$@) {
-	# Use a Perl module
-	my $out;
-	Image::PNG::QRCode::qrpng(
-		text => $str,
-		scale => $size || 6,
-		out => \$out,
-		);
-	return ($out, "image/png");
-	}
 return (undef, "QR code generation requires either the qrencode command or ".
-	       "Image::PNG::QRCode Perl module");
+	       "QRCode::Encoder Perl module");
+}
+
+# generate_qr_code_encoder(string, [block-size])
+# Turn a string into a QR code SVG using the local QRCode::Encoder fallback
+sub generate_qr_code_encoder
+{
+my ($str, $size) = @_;
+eval "use lib (\"$root_directory/vendor_perl\")";
+eval "use QRCode::Encoder qw(qr_encode)";
+if ($@) {
+	return (undef, "QR code generation requires the ".
+		       "QRCode::Encoder Perl module");
+	}
+my $encoded = qr_encode($str, level => 'M');
+my $matrix = $encoded->{'matrix'};
+my $mod_size = $size || 6;
+my $count = scalar(@$matrix);
+my $dim = $count * $mod_size;
+my $svg = qq{<svg xmlns="http://www.w3.org/2000/svg" }.
+	  qq{viewBox="0 0 $dim $dim" }.
+	  qq{width="$dim" height="$dim">};
+$svg .= qq{<rect width="$dim" height="$dim" fill="white"/>};
+for my $y (0 .. $#$matrix) {
+	for my $x (0 .. $#{$matrix->[$y]}) {
+		if ($matrix->[$y][$x] & 1) {
+			my $px = $x * $mod_size;
+			my $py = $y * $mod_size;
+			$svg .= qq{<rect x="$px" y="$py" }.
+				qq{width="$mod_size" }.
+				qq{height="$mod_size"/>};
+			}
+		}
+	}
+$svg .= "</svg>";
+return ($svg, "image/svg+xml");
 }
 
 1;