File: 61_threads-cb-crash.t

package info (click to toggle)
libnet-ssleay-perl 1.48-1
  • links: PTS, VCS
  • area: main
  • in suites: wheezy
  • size: 1,748 kB
  • sloc: perl: 5,209; makefile: 2
file content (69 lines) | stat: -rw-r--r-- 2,227 bytes parent folder | download | duplicates (5)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
use strict;
use warnings;
use Config;
use Test::More;

BEGIN {
  plan skip_all => "your perl is not compiled with ithreads or is pre-5.8" unless $Config{useithreads} && $] >= 5.008;
  require threads;
};

#XXX-TODO perhaps perl+ithreads related issue (needs more investigation)
plan skip_all => "this test sometimes crashes on cygwin" if $^O eq 'cygwin';

# NOTE: expect warnings about threads still running under perl 5.8 and threads 1.71
plan tests => 1;

use FindBin;
use File::Spec;
use Net::SSLeay;

my $start_time = time;
my $file = File::Spec->catfile('t', 'data', 'key.pem');

Net::SSLeay::randomize();
Net::SSLeay::load_error_strings();
Net::SSLeay::SSLeay_add_ssl_algorithms();

#exit the whole program if it runs too long
threads->new( sub { sleep 20; warn "FATAL: TIMEOUT!"; exit } )->detach;

#print STDERR "Gonna start main thread part\n";
my $ctx = Net::SSLeay::CTX_new() or warn "CTX_new failed" and exit;
Net::SSLeay::CTX_set_default_passwd_cb($ctx, \&callback);
Net::SSLeay::CTX_use_PrivateKey_file($ctx, $file, &Net::SSLeay::FILETYPE_PEM) or warn "CTX_use_PrivateKey_file (file=$file) failed" and exit;
Net::SSLeay::CTX_set_default_passwd_cb($ctx, undef);
Net::SSLeay::CTX_free($ctx);

#print STDERR "Gonna start multi-threading part\n";
threads->new(\&do_check) for (1..10);

#print STDERR "Waiting for all threads to finish\n";
do_sleep(50) while(threads->list());

pass("successfully finished, duration=".(time-$start_time));
exit(0);

sub callback {
  #printf STDERR ("[thread:%04d] Inside callback\n", threads->tid);
  return "secret"; # password
}

sub do_sleep {
  my $miliseconds = shift;
  select(undef, undef, undef, $miliseconds/1000);
}

sub do_check {
  #printf STDERR ("[thread:%04d] do_check started\n", threads->tid);
  
  my $c = Net::SSLeay::CTX_new() or warn "CTX_new failed" and exit;
  Net::SSLeay::CTX_set_default_passwd_cb($c, \&callback);
  Net::SSLeay::CTX_use_PrivateKey_file($c, $file, &Net::SSLeay::FILETYPE_PEM) or warn "CTX_use_PrivateKey_file (file=$file) failed" and exit;
  Net::SSLeay::CTX_set_default_passwd_cb($c, undef);
  Net::SSLeay::CTX_free($c);
  #do_sleep(rand(500));
    
  #printf STDERR ("[thread:%04d] do_check finished\n", threads->tid);
  threads->detach();
}