Jemand zu Hause?![[twitter]](/battie/theme/default/icons/twitter.gif){kind=icon}
![[solved]](/battie/theme/default/icons/tick.png "solved"){kind=icon}
+8 replies
+7 replies
Tk::Entry in der Lage, Passwordabfragen zu machen (sprich: das eingegebene zu verbergen).
+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
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
#!/usr/bin/perl
# -----------------------------------------------------------------------------
use strict;
use warnings;
use Modules::Parser;
# -----------------------------------------------------------------------------
my $Config_Eintraege = &Parser_Initialisierung( );
# -----------------------------------------------------------------------------
# SSL - Server
use IO::Socket::SSL;
&Parser_Pruefung( );
my $SSL_Server = IO::Socket::SSL -> new(
# Initialisierung der Server - Adresse & des Ports
LocalAddr => $Config_Eintraege -> { SSL_SERVER_ADRESSE } ,
LocalPort => $Config_Eintraege -> { SSL_SERVER_PORT } ,
Listen => 10 ,
# Zertifikate für die Authentifizierung
SSL_cert_file => $Config_Eintraege -> { SSL_SERVER_PUBLIC_KEY_FOLDER } . $Config_Eintraege -> { SSL_SERVER_PUBLIC_KEY_IDENTIFIER } ,
SSL_key_file => $Config_Eintraege -> { SSL_SERVER_PRIVATE_KEY_FOLDER } . $Config_Eintraege -> { SSL_SERVER_PRIVATE_KEY_IDENTIFIER } ,
) 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 : !";
my $client_address = $Akzeptierung_Verbindung_Clients -> peerhost();
my $client_port = $Akzeptierung_Verbindung_Clients -> peerport();
print "Eingehende Verbindung : $client_address:$client_port" , "\n";
my $data = "";
$Akzeptierung_Verbindung_Clients -> read( $data , 1024 );
my @Pruefung_Eintraege = split( / , / , $data );
print "Ausgabe : $Pruefung_Eintraege[ 0 ]" , "\n";
print "Ausgabe : $Pruefung_Eintraege[ 1 ]" , "\n";
print "Ausgabe : $Pruefung_Eintraege[ 2 ]" , "\n";
my $Server_Rueckmeldung = "OK";
$Akzeptierung_Verbindung_Clients -> print( $Server_Rueckmeldung );
shutdown( $Akzeptierung_Verbindung_Clients , 1 );
}
$SSL_Server -> close( );
# -----------------------------------------------------------------------------
1;
QuoteKeys should be PEM formatted, and if they are encrypted, you will be prompted to enter a password before the socket is formed (unless you specified the SSL_passwd_cb option).
+5 replies
IO::Socket::SSL akzeptiert dessen new() Methode einen Eintrag SSL_passwd_cb, über den Du eine eigene Routine angeben kannst, die das Passwort zurückliefert. Also wäre das auch mit Tk machbar.perldoc IO::Socket::SSLnew(...)
Creates a new IO::Socket::SSL object. You may use all the friendly options that came bundled with the super class (e.g. IO::Socket::IP, IO::Socket::INET, ...) plus (optionally) the ones described below. If you don't specify any SSL related options it will do its best in using secure defaults, e.g. choosing good ciphers, enabling proper verification, etc.
...
SSL_passwd_cb
If your private key is encrypted, you might not want the default password prompt from Net::SSLeay. This option takes a reference to a subroutine that should return the password required to decrypt your private key.
...
+2 replies
+2 replies
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
# SSL - Server
use IO::Socket::SSL;
&Parser_Pruefung( );
my $SSL_Server = IO::Socket::SSL -> new(
# Initialisierung der Server - Adresse & des Ports
LocalAddr => $Config_Eintraege -> { SSL_SERVER_ADRESSE } ,
LocalPort => $Config_Eintraege -> { SSL_SERVER_PORT } ,
Listen => 10 ,
# Zertifikate für die Authentifizierung
SSL_cert_file => $Config_Eintraege -> { SSL_SERVER_PUBLIC_KEY_FOLDER } . $Config_Eintraege -> { SSL_SERVER_PUBLIC_KEY_IDENTIFIER } ,
SSL_key_file => $Config_Eintraege -> { SSL_SERVER_PRIVATE_KEY_FOLDER } . $Config_Eintraege -> { SSL_SERVER_PRIVATE_KEY_IDENTIFIER } ,
SSL_passwd_cb => sub{ my $PW_Identifizierung_Rueckgabe = &PW_Identifizierung( );
print "Rueckgabe : $PW_Identifizierung_Rueckgabe" , "\n"; } ,
) or die "failed to listen: $!";
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
Font
Tipp zum Debugging
Blog
Preferences![[feed]](/battie/theme/default/icons/feed.png){kind=icon}
Tags:
sub PW_Identifizierung {
my $PW_Identifizierung_Fenster = MainWindow -> new( -title => "PW - Abfrage" );
my $Breite = 280;
my $Hoehe = 140;
$PW_Identifizierung_Fenster -> geometry( $Breite . 'x' . $Hoehe );
my $PW_Identifizierung_Eintrag = $PW_Identifizierung_Fenster -> Entry( -width => 32 ,
-relief => 'sunken' ,
-bd => 2 ,
-justify => 'center' ,
-show => '*' ,
) -> place( -x => 41 , -y => 65 );
my $PW_Identifizierung_Ergebnis = "";
my $PW_Identifizierung_Rueckgabe = $PW_Identifizierung_Fenster -> Button( -text => 'OK' ,
-width => 14 ,
-command => sub{ $PW_Identifizierung_Ergebnis = $PW_Identifizierung_Eintrag -> get( );
print "Ergebnis : $PW_Identifizierung_Ergebnis" , "\n";
return( $PW_Identifizierung_Ergebnis );
}
) -> place( -x => 40 , -y => 95 );
MainLoop( )
}
1
2
SSL_passwd_cb => sub{ my $PW_Identifizierung_Rueckgabe = &PW_Identifizierung( );
print "Rueckgabe : $PW_Identifizierung_Rueckgabe" , "\n"; } ,SSL_passwd_cb => \&PW_Identifizierung,
![[Powered by Battie]](/battie/img/powered.png)
