view release on metacpan or  search on metacpan

t/20-console.t  view on Meta::CPAN

   $buf->{stringify_mask} = undef;
   is("$buf", "password", 'Buffer contains expected password');
   is($buf->length, 8, 'Buffer length matches password length');
};

# Test with empty line
subtest 'append_console_line with empty line' => sub {
   my ($r, $w)= pipe_with_data("\n");
   $w->close;

   my $buf = Crypt::SecretBuffer->new;
   my $result = $buf->append_console_line($r);
   ok($result, 'append_console_line returns true with empty line');
   is($buf->length, 0, 'Buffer length is zero for empty line');
};

# Test with no newline
subtest 'append_console_line with no newline' => sub {
   skip_all "Nonblocking doesn't work on Win32"
      if $^O eq 'MSWin32';

   my ($r, $w)= pipe_with_data("incomplete");
   $r->blocking(0);

   my $buf = Crypt::SecretBuffer->new;
   $buf->{stringify_mask} = undef;

   my $result = $buf->append_console_line($r);
   is($result, undef, 'append_console_line returns undef on nonblocking incomplete line');

   is("$buf", "incomplete", 'Buffer contains partial data');
   is($buf->length, 10, 'Buffer length matches input length');
};

subtest 'parent/child pipe communication' => sub {
   my ($read_fh, $write_fh)= pipe_with_data();
   
   my $pid = fork();
   die "Cannot fork: $!" unless defined $pid;
   
   if ($pid == 0) {
      # Child process
      print $write_fh "secret from child process\n";
      exit(0);
   }
   
   # Parent process
   my $buf = Crypt::SecretBuffer->new();
   my $result = $buf->append_console_line($read_fh);
   
   is($result, T, 'append_console_line returns true when reading from child process pipe');
   is($buf->length, 25, 'buffer contains correct number of characters from child process');
   
   $buf->{stringify_mask} = undef;
   is("$buf", 'secret from child process', 'content from child process is correct');
   
   waitpid($pid, 0);
   close($read_fh);
};

subtest unicode => sub {
   my ($read_fh, $write_fh)= pipe_with_data();

   my $pid = fork();
   die "Cannot fork: $!" unless defined $pid;

   if ($pid == 0) {
      # Child process
      binmode($write_fh, ':encoding(utf-8)');
      print $write_fh "unicode \x{100} \x{1000}\n";
      exit(0);
   }

   # Parent process
   my $buf = Crypt::SecretBuffer->new();
   my $result = $buf->append_console_line($read_fh, utf8 => 1);

   is($result, T, 'append_console_line returns true when reading from child process pipe');
   note 'contents: "'.$buf->unmask_to(\&escape_nonprintable).'"';
   is($buf->span(encoding => 'UTF-8')->cmp("unicode \x{100} \x{1000}"), 0,
      'buffer contains correct utf8 data from child process');
   waitpid($pid, 0);
   close($read_fh);
};

use Socket qw(AF_UNIX SOCK_STREAM PF_UNSPEC );
subtest 'timeout loop' => sub {
   pipe(my $input_r,  my $input_w) or die "Cannot create pipe: $!";
   # Use socketpair for control because it is select()able on Win32
   socketpair(my $parent, my $child, AF_UNIX, SOCK_STREAM, PF_UNSPEC)
      or die "socketpair: $!";
   $_->autoflush(1) for $input_w, $parent, $child;
   
   my $ppid= $$;
   my $pid = fork();
   die "Cannot fork: $!" unless defined $pid;
   if ($pid == 0) {
      # Child process (or thread on Win32)
      $input_w->print("secret ");
      sleep 1;
      $input_w->print("from child process\n");
      # Wait up to 10 seconds for message from main thread
      # that the test is done, else kill parent process.
      my $rfd= '';
      vec($rfd, fileno($child), 1)= 1;
      my $n= select($rfd, undef, undef, 10);
      if ($n <= 0) {
         # timeout.  stop parent from hanging forever.
         note "child killing parent";
         kill TERM => $ppid;
      }
      note "child exits cleanly";
      exit 0;
   }

   # Parent process
   pipe(my $prompt_r, my $prompt_w) or die "Cannot create pipe: $!";
   my $buf = Crypt::SecretBuffer->new();
   my $timeouts= 0;
   my $result;
   my %state;
   while (1) {
      my $start_t= time;
      $!= 0;
      $result = $buf->append_console_line(
         input_fh => $input_r, prompt_fh => $prompt_w,
         prompt => 'password: ',
         timeout => .2, state => \%state
      );
      note sprintf("append_console_line = %s, errno = %s, chars = %d, elapsed %.3f",
         (defined $result? $result : '<undef>'), $!, $buf->length, (time - $start_t));
      last if defined $result or !$!{EINTR};
      ++$timeouts;
   }

   is($result, T, 'append_console_line returns true when reading from child process pipe');
   ok($timeouts > 0, 'more than one timeout');
   is($buf->length, 25, 'buffer contains correct number of characters from child process');
   $prompt_w->close;
   my $prompt_buf= do { local $/; <$prompt_r> };