perlmojolicious-liteqx

Why does perl qx hang in Mojolicious::Lite but not in an ordinary program?


(This is cperl 5, version 24, subversion 4 (v5.24.4c) built for x86_64-linux) Ubuntu 18.04.

Below is a program that works. However, when I run this program from within Mojolicious::Lite (version 6.04), it hangs. Using top, I see that "tr" is the one eating all the CPU. I have tried using cat instead of tr and it still hangs. If I Control-C the Mojo code it prints the password then exits. It is like tr is accepting the urandom bytes but not moving on to the fold until I interrupt it. But, this works in the ordinary script, not the Mojo one...

Anyone any ideas as to why?

Warmly

John

The script that works:

#! /usr/bin/perl
use strict;
use warnings;
use Data::Dumper;

my $pass_length = 3;
my $exec = qq{tr -cd "[:alnum:]" < /dev/urandom | fold -w$pass_length | head -n1};
print Dumper $exec;
my $pass = qx{$exec};
chomp $pass;
print Dumper $pass;

The Mojolicious Lite code that hangs:

use Mojolicious::Lite;

use strict;
use warnings;

use Data::Dumper;

post 'testit' => sub {
    my $c = shift;

    my $pass_length = 3;
    # tr -cd '[:alnum:]' < /dev/urandom | fold -w30 | head -n1
    my $exec = qq{tr -cd '[:alnum:]' < /dev/urandom | fold -w$pass_length | head -n1};
    warn Dumper $exec;
    my $pass = qx{$exec};
    chomp $pass;
    warn Dumper $pass;
    return $c->render( json => { foo => 'bar'} );
};

app->secrets('foobar');
app->start;

Solution

  • sub gen_password {
       my ($pass_len) = @_;
    
       # We use sysread to avoid wasting entropy by over-reading.
       # We use :raw because we use sysread.
    
       state $bad_syms = {
          map { $_ => 1 }
             qw( 0 O I 1 l )
       };
       state $ok_syms = {
          map { $_ => 1 }
             grep !$bad_syms->{$_},
                'a'..'z', 'A'..'Z', '0'..'9'
       };
    
       my $qfn = '/dev/urandom';
       open(my $fh, '<:raw', $qfn)
          or die("Can't open $qfn: $!\n");
    
       my $password = '';
       while (length($password) < $pass_len) {
          my $rv = sysread($fh, my $ch, 1);
          die("Can't read $qfn: $!\n") if !defined($rv);
          die("Can't read $qfn: Premature EOF\n") if !$rv;
          redo if !$ok_syms->{$ch};
    
          $password .= $ch;
       }
    
       return $password;
    }
    

    Benefits:


    The following version wastes even less entropy, but requires a set of exactly 64 symbols:

    use MIME::Base64 qw( encode_base64 );
    
    sub gen_password {
       my ($pass_len) = @_;
    
       my $qfn = '/dev/urandom';
       open(my $fh, '<:raw', $qfn)
          or die("Can't open $qfn: $!\n");
    
       my $bytes = int( ($pass_len+3) * (3/4) );
       my $buf = '';
       while ($bytes) {
          my $rv = sysread($fh, $buf, $bytes, length($buf));
          die("Can't read $qfn: $!\n") if !defined($rv);
          die("Can't read $qfn: Premature EOF\n") if !$rv;
          $bytes -= $rv;
       }
    
       return substr(
          encode_base64($buf, '') =~
             tr/a-zA-Z0-9+\//a-km-zA-HJ-NP-Z2-9!%^&*()/r,
          0, $pass_len,
       );
    }