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

214 Views Asked by At

(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;
2

There are 2 best solutions below

2
On BEST ANSWER
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:

  • More efficient.
  • Fewer failure modes.
  • Better error handling.
  • Guaranteed to be the requested length.
  • Avoids confusingly similar characters.

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,
   );
}
6
On

I am not sure why tr hangs when directly taking input from /dev/urandom. I was able to work around it by having an intermediate cat pipe before the tr. The following works for me:

my $exec = qq{head -1 /dev/urandom | cat | tr -cd '[:alnum:'] | fold -w$pass_length}

Edit:

If you want to generate a password of $pass_length characters, you can use head -c like this:

my $exec = qq{head -1 /dev/urandom | cat | tr -cd '[:alnum:'] | head -c $pass_length}