Jemand zu Hause?![[twitter]](/battie/theme/default/icons/twitter.gif){kind=icon}
![[gelöst]](/battie/theme/default/icons/tick.png "gelöst"){kind=icon}
Leser: 13
+10 replies
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
# SSL - Server
my $SSL_Server = IO::Socket::SSL -> new(
# Initialisierung der Server - Adresse & des Ports
LocalAddr => '127.0.0.1' ,
LocalPort => 8000 ,
Listen => 10 ,
# Zertifikate für die Authentifizierung
SSL_cert_file => 'D:\PERL\Programmierung\Server\Certs\ca-root.pem',
SSL_key_file => 'D:\PERL\Programmierung\Server\Certs\ca-key.pem',
) or die "failed to listen: $!";
# -----------------------------------------------------------------------------
# Akzeptiere Clients
while( 1 )
{
# Warte auf neue Verbindung
my $Akzeptierung_Verbindung_Clients = $SSL_Server -> accept or die
"Fehler bei der Akzeptierung des Handshakes : !";
# get information about a newly connected client
my $client_address = $Akzeptierung_Verbindung_Clients -> peerhost();
my $client_port = $Akzeptierung_Verbindung_Clients -> peerport();
print "Eingehende Verbindung : $client_address:$client_port" , "\n";
# read up to 1024 characters from the connected client
my $data = "";
$Akzeptierung_Verbindung_Clients -> read( $data , 1024 );
my @Pruefung_Lizenzierung = split( / , / , $data );
print "Ausgabe : $Pruefung_Lizenzierung[ 0 ]" , "\n";
print "Ausgabe : $Pruefung_Lizenzierung[ 1 ]" , "\n";
print "Ausgabe : $Pruefung_Lizenzierung[ 2 ]" , "\n";
my $Server_Rueckmeldung = "OK";
$Akzeptierung_Verbindung_Clients -> print( $Server_Rueckmeldung );
# notify client that response has been sent
shutdown( $Akzeptierung_Verbindung_Clients , 1 );
}
$SSL_Server -> close( );
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
#!/usr/bin/perl
use threads;
use threads::shared;
$|=1;
my ($global) : shared ;
my $thr1 = threads->new(\&TEST,1) ;
my $thr2 = threads->new(\&TEST,2) ;
my @ReturnData = $thr1->join ;
print "Thread 1 returned: @ReturnData\n" ;
my @ReturnData = $thr2->join ;
print "Thread 2 returned: @ReturnData\n" ;
sub TEST {
my ( $id ) = @_ ;
for(0..10) {
$global++ ;
print "id: $id >> $_ >> GLB: $global\n" ;
sleep(1) ;
}
return( $id ) ;
}
+2 replies![[Homepage]](/battie/theme/default/homepage.gif)
![[default_avatar]](/battie/theme/default/default_avatar.gif){kind=avatar}
QuoteIf you have a non-blocking socket, the expected behavior on read, write, accept or connect is to set $! to EAGAIN if the operation can not be completed immediately.
QuoteWith SSL handshakes might occure at any time, even within an established connections. In this cases it is necessary to finish the handshake, before you can read or write data. This might result in situations, where you want to read but must first finish the write of a handshake or where you want to write but must first finish a read. In these cases $! is set to EGAIN like expected, and additionally $SSL_ERROR is set to either SSL_WANT_READ or SSL_WANT_WRITE. Thus if you get EAGAIN on a SSL socket you must check $SSL_ERROR for SSL_WANT_* and adapt your event mask accordingly.
Using readline on non-blocking sockets does not make much sense and I would advise against using it. And, while the behavior is not documented for other IO::Socket classes, it will try to emulate the behavior seen there, e.g. to return the received data instead of blocking, even if the line is not complete. If an unrecoverable error occurs it will return nothing, even if it already received some data.
Also, I would advise against using accept with a non-blocking SSL object, because it might block and this is not what most would expect. The reason for this is that accept on a non-blocking TCP socket (e.g. IO::Socket::IP, IO::Socket::INET..) results in a new TCP socket, which does not inherit the non-blocking behavior of the master socket. And thus the initial SSL handshake on the new socket inside IO::Socket::SSL::accept will be done in a blocking way. To work around it you should better do an TCP accept and later upgrade the TCP socket in a non-blocking way with start_SSL and accept_SSL.
+7 replies
+6 replies
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
#!/usr/bin/perl
use strict;
my $k_pid;
die "Can't fork! ($!)" unless defined ($k_pid = fork());
my $i = 1;
my $n = 1;
if ($k_pid) {
#parent code
while (1==1) {
$n++;
print "Parent ($i)($n) \n";
sleep(1);
}
kill("TERM" => $k_pid);
} else {
#child code
while (1==1) {
$i++;
print "Child: ($i)($n)\n";
sleep(1);
}
}
+5 replies
Win32::Process. Ich nutze das sehr gern, das ist genial!
+4 replies
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
my $Prozess_Struktur;
my $Aufruf_Prozesse_Struktur = Win32::Process::Create( $Prozess_Struktur,
"C:\\Strawberry\\perl\\bin\\perl.exe",
"perl D:\\PERL\\Programmierung\\Testumgebung\\Tray.pl",
0 ,
NORMAL_PRIORITY_CLASS,
"." ) || die ErrorReport( );
my $Prozess_Nummer_Struktur = $Prozess_Struktur -> GetProcessID( );
print "Prozess - Nr. der Struktur : $Prozess_Nummer_Struktur" , "\n";
# -----------------------------------------------------------------------------
my $Prozess_SSL_Server;
my $Aufruf_Prozesse_SSL_Server = Win32::Process::Create( $Prozess_SSL_Server,
"C:\\Strawberry\\perl\\bin\\perl.exe",
"perl D:\\PERL\\Programmierung\\Testumgebung\\SSL_Server.pl",
0 ,
NORMAL_PRIORITY_CLASS,
"." ) || die ErrorReport( );
my $Prozess_Nummer_SSL_Server = $Prozess_SSL_Server -> GetProcessID( );
print "Prozess - Nr. der SSL - Servers : $Prozess_Nummer_SSL_Server" , "\n";
$Prozess_SSL_Server -> Suspend( );
$Prozess_SSL_Server -> Resume( );
$Prozess_SSL_Server -> Wait( INFINITE );
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
70
71
72
73
74
75
76
77
#!"C:\Program Files (x86)\Active Perl 5.20.1\bin\perl.exe"
# ----------------------------------------------------------------------------------------------------------------------------
use strict;
use warnings;
use Win32::GUI();
# ----------------------------------------------------------------------------------------------------------------------------
my $menu_popup;
my $debug = 1;
$menu_popup = Win32::GUI::Menu -> new( "&File" => "File" ,
">SSL - Server" => { -name => "SSL_Server" , -state => 0 , -onClick => sub{ -1 } } ,
">>Aktiviere Verbindung" => { -name => "Aktivierung" , -state => 0 , -onClick => sub{ $menu_popup -> { 'Trennung' } -> Enabled( 1 );
$menu_popup -> { 'Aktivierung' } -> Enabled( 0 ); } } ,
">>Schliesse Verbindung" => { -name => "Trennung" , -state => 0 , -onClick => sub{ $menu_popup -> { 'Trennung' } -> Enabled( 0 );
$menu_popup -> { 'Aktivierung' } -> Enabled( 1 ); } } ,
"> -" => { -name => "Trenner" , -state => 1 , -onClick => sub{ 0 } } ,
">Server - Verwaltung" => { -name => "Server_Verwaltung" , -state => 0 , -onClick => sub{ -1 } } ,
">Benutzer - Verwaltung" => { -name => "Benutzer_Verwaltung" , -state => 0 , -onClick => sub{ &Mailing( ) } } ,
"> -" => { -name => "Trenner" , -state => 1 , -onClick => sub{ 0 } } ,
">Ende" => { -name => "Ende" , -state => 0 , -onClick => sub{ -1 } } ,
);
$menu_popup -> { 'Trennung' } -> Enabled( 0 );
my $main = Win32::GUI::Window -> new( -name => 'Main' ,
-text => '' ,
-menu => $menu_popup ,
-width => 0 ,
-height => 0
);
sub NI_RightClick( ) {
$main -> TrackPopupMenu( $menu_popup -> { File } , Win32::GUI::GetCursorPos( ) );
}
my $icon = new Win32::GUI::Icon( 'Symbol.ico' );
my $ni = $main -> AddNotifyIcon( -name => "NI" ,
-icon => $icon ,
-tip => "Hello"
);
Win32::GUI::Dialog( );
# -----------------------------------------------------------------------------
sub Main_Terminate {
return -1;
}
# -----------------------------------------------------------------------------
sub Main_Minimize {
$main -> Disable();
$main -> Hide();
return 1;
}
# -----------------------------------------------------------------------------
sub NI_Click {
$main -> Enable();
$main -> Show();
return 1;
}
# -----------------------------------------------------------------------------
1;
+3 replies
2016-03-11T00:37:28 YAPDIch möchte aber den SSL Server aus dem Tray - Menu heraus aufrufen,
wenn ich auf den Menu - Punkt "Aktiviere Verbindung" klicke.
+2 replies
Schrift
Tipp zum Debugging
Blog
Einstellungen![[feed]](/battie/theme/default/icons/feed.png){kind=icon}
![[Powered by Battie]](/battie/img/powered.png)
