Jemand zu Hause?![[twitter]](/battie/theme/default/icons/twitter.gif){kind=icon}
+33 replies![[default_avatar]](/battie/theme/default/default_avatar.gif){kind=avatar}
1
2
3
4
5
6
7
8
9
Parent:
my $name = "Sascha";
Kind
print $name; # Ausgabe sascha
$name = "alex";
print $name; # Ausgabe alex
+2 replies![[Homepage]](/battie/theme/default/homepage.gif)
+29 replies
+28 replies
Can't store GLOB items at ../../lib/Storable.pm (autosplit into ../../lib/auto/Storable/_freeze.al) line 339, at /home/chat4you/perl5/lib/perl5/IPC/Shareable.pm line 524
+27 replies
+26 replies
+25 replies
2017-08-10T07:18:30 Sascha2018Hallo.
Es kann sinnvoll sein.
Wie gesagt... Habe alle Verbindungen ( Sockets ) in einem
Hash gespeichert damit man später im Programm einem bestimmten Socket
eine Nachricht schicken kann.
Blos IPC::Shareable scheint nicht davon begeistert zu sein.
Lg
+24 replies
+23 replies
perlipc Darin stehen verschiedene Ideen, wie sowas gemacht werden könnte.
+22 replies
my $conn = $socket->accept;
1
2
3
4
Schrift
Wie installiert man ein Modul?
Blog
Einstellungen![[feed]](/battie/theme/default/icons/feed.png){kind=icon}
Tags:
foreach my $client(keys %clients){
. my $sock = $client;
. $sock->syswrite("hello world");
. }
+21 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
package ArrayStore; use strict; use warnings; use IO::File; use Fcntl qw(:flock); use Storable qw(freeze thaw); sub new{ my $class = shift; my %cfg = ( file => '', flock => 0, @_); return eval{ my $fh = IO::File->new; $fh->open($cfg{file}, O_CREAT|O_BINARY|O_RDWR) or die $!; my $isflock = $cfg{flock} ? flock $fh, LOCK_EX : -1; warn "flock is not supported" unless $isflock; bless{ FH => $fh }, $class; } } # Array aus Datei lesen sub read{ my $self = shift; $self->{FH}->seek(0,0); read($self->{FH}, my $bin, -s $self->{FH}); return length $bin ? thaw($bin) : []; } # Array nach Datei serialisieren sub write{ my $self = shift; my $r = shift; $self->{FH}->seek(0,0); $self->{FH}->truncate(0); $self->{FH}->print(freeze($r)); } 1;########################################################################### __END__ use Data::Dumper; my $as = ArrayStore->new( file => 'stbin', flock => 1 ) or die $@; $as->write([{},{}]); my $r = $as->read; print Dumper $r;
+20 replies
+5 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
#!/usr/bin/perl
use strict;
no strict 'refs';
use warnings;
use IO::Socket;
use IO::Select;
use Parallel::ForkManager;
our $die = 0;
$SIG{INT} = sub{ $die = 1; exit; };
our %clients = ();
our $select = IO::Select->new;
my $server = IO::Socket::INET->new( LocalHost => 'localhost',
LocalPort => 2222,
Proto => 'tcp',
Listen => 10000,
Reuse => 1,
) or die "Sock Error: $!\n";
our $pm = Parallel::ForkManager->new(10);
$pm->run_on_finish(sub{
my($pid,$exitcode,$ident,$exitsignal,$coredump,$get)=@_;
# Jetzt Sockets updaten :-)
my $sock = $get->{socket};
my $ip = $get->{ip};
my $id = $get->{ident};
$clients{$sock}->{socket} = $sock;
$clients{$sock}->{ip} = $ip;
$clients{$sock}->{ident} = $ident;
# Ende Update
});
$server->autoflush(1); # Autoflush für ältere Perl Versionen.
$select->add($server);
while(!$die){
foreach our $key( $select->can_read()) { # foreach
if($key eq $server) { # if $bay eq $server
next if $key eq "";
our $bay = $server->accept or next;
my $ip = $bay->peerhost();
$select->add($bay);
$pm->start and next;
my @phrase = ("a" .."z","A".."Z",0..9);
my $ident = join '', map { $phrase[int rand @phrase] } 1..10;
$clients{$bay}->{ip} = $ip;
$clients{$bay}->{ident} = $ident;
foreach my $client( keys %clients ){
print "Verbindung von $clients{$client}->{ip} mit der Ident $clients{$client}->{ident}... OK\n";
}
my $data = $pm->finish(0, { ip => $ip, ident => $ident, socket => \*{ $bay } });
}
}
$pm->wait_all_children;
}
The storable module was unable to store the child's data structure to the temp file "/tmp/jtXd3_MxiB/Parallel-ForkManager-8516-8518.txt": Can't store GLOB items at /usr/lib/i386-linux-gnu/perl/5.24/Storable.pm line 265, at /usr/local/share/perl/5.24.1/Parallel/ForkManager.pm line 84.
+2 replies
Storable kann keine GLOBS speichern. http://perldoc.perl.org/Storable.html#BUGS
+2 replies
+14 replies
+13 replies
+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
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
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
#!/usr/bin/perl
use strict;
use warnings;
use feature 'state';
no strict 'refs';
use IO::Socket;
use IO::Select;
use Parallel::ForkManager;
my $die = 0;
my %lkup;
$|=1;
sub _uid {
state $uid = 0;
$uid = 1 if ++$uid > 2e9;
$uid;
}
my %clients = ();
my $select = IO::Select->new;
my $server = IO::Socket::INET->new(
LocalHost => '127.0.0.1',
LocalPort => 2222,
Proto => 'tcp',
Listen => 10000,
Reuse => 1,
) or die "Sock Error: $!\n";
my $pm = Parallel::ForkManager->new(500);
$pm->set_waitpid_blocking_sleep(0);
$pm->run_on_finish( sub {
my ($pid,$exitcode,$ident,$exitsignal,$coredump,$get) = @_;
$clients{$ident}->{ident} = $ident;
$clients{$ident}->{ip} = $get->{ip};
$clients{$ident}->{socket} = delete $lkup{$ident};
my $killsock = $get->{killing} || 0;
my $sock = $clients{$ident}->{socket};
if($killsock){
delete $clients{$ident};
$select->remove($sock);
}
});
$server->autoflush(1);
$select->add($server);
while (1) {
foreach my $key ($select->can_read()) { # foreach
if ($key eq $server) { # if $bay eq $server
next if $key eq "";
my $bay = $server->accept or next;
my $ip = $bay->peerhost();
our $ident = _uid();
$lkup{$ident} = $bay;
$select->add($bay);
my $buffer = <$bay>;
$pm->start($ident) and next;
my $killing = 0;
if( defined $buffer && $buffer =~ m/^GET\s\/\?sid=12\sHTTP\/1\.1\s/ ){
print "$buffer";
sendHeader($bay);
print "OK";
for( 1 .. 30 ){ # Firefox and other browsers
$bay->syswrite("<!-- //--><!-- //--><!-- //--><!-- //--><!-- //-->\n\n");
}
my $html=<<"EOT";
<html>
<head>
<title>hallo</title>
</head>
<body style='background-color: darkblue; color: #FFFFFF'>
hello world
</body>
</html>
EOT
$bay->syswrite($html);
}elsif( defined $buffer && $buffer =~ m/^GET\s\/\?printoall=1\sHTTP\/1\.1\s/ ){
foreach my $client( keys %clients ){
print "$buffer";
my $socket = $clients{$client}->{socket};
$socket->syswrite("The sun is shining\n");
print "Conntected: \n" . keys %clients;
}
$killing = 1;
}
$pm->finish(0, { ip => $ip, killing => $killing });
}
}
$pm->wait_all_children;
}
sub sendHeader {
my $client = shift;
if( defined $client ) {
my $header =<<"EOT";
HTTP/1.1 200 OK
Content-type: text/html\n\n
EOT
$client->syswrite($header);
}
}
+3 replies
+2 replies
2017-08-12T15:42:29 Sascha2018Durch $pm->start wird fork() aufgerufen.
Über $pm->finish(0, { # vars }) werden die Variablen des Kindprozesses am Ende des Durchlaufs aktualisiert.
lg
+8 replies
+7 replies
+6 replies
+5 replies
+4 replies
2017-08-13T08:36:09 Sascha2018%clients wird nach Ende des Childprozess im Hauptprozess geupdatet.
$lkup{$ident} wird im Hauptprozess dem Socket vom accept() zugewiesen und am Ende des Kindprozess $clients{$ident}->{socket} in der run_on_fish subroutine durch die delete Funktion zugewiesen.
+3 replies
+2 replies
1
2
3
DEBUG: .../IO/Socket/SSL.pm:1492: new ctx 32253824
DEBUG: .../IO/Socket/SSL.pm:938: start handshake
DEBUG: .../IO/Socket/SSL.pm:505: starting sslifying
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
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
use strict;
use warnings;
use feature 'state';
no strict 'refs';
my %lkup;
our %config;
our %language;
our $dbh;
our %srv_modes;
our $HOST = $config{server};
our $PORT = $config{port};
our $last_RnR = time;
our $last_UPDATE = time;
our( %srvban, %loggedin, %rooms) = ((),(),(),());
my $uid;
my $die = 0;
require "config.cfg";
require 5.002;
use IO::Socket::SSL 'inet4';
use IO::Select;
$IO::Socket::SSL::DEBUG = 3;
use Time::HiRes;
use HTML::Template;
use Text::Wrap;
use Fcntl ':flock';
use strict;
no strict 'refs';
$SIG{INT} = sub{ exit; };
use Parallel::ForkManager;
$|=1;
sub _uid {
state $uid = 0;
$uid = 1 if ++$uid > 2e9;
$uid;
}
my %clients = ();
my $select = IO::Select->new;
my $server = IO::Socket::INET->new(
LocalHost => 'host',
LocalPort => 63027,
Proto => 'tcp',
Listen => 10000,
Reuse => 1,
) or die "Sock Error: $!\n";
my $pm = Parallel::ForkManager->new(500);
$pm->set_waitpid_blocking_sleep(0);
$pm->run_on_finish( sub {
my ($pid,$exitcode,$ident,$exitsignal,$coredump,$get) = @_;
$clients{$ident}->{ident} = $ident;
$clients{$ident}->{ip} = $get->{ip};
$clients{$ident}->{socket} = delete $lkup{$ident};
my $killsock = $get->{killing} || 0;
my $sock = $clients{$ident}->{socket};
if($killsock){
delete $clients{$ident};
$select->remove($sock);
}
});
$server->autoflush(1);
$select->add($server);
while (1) {
foreach my $key ($select->can_read()) { # foreach
if ($key eq $server) { # if $bay eq $server
next if $key eq "";
our $bay = $server->accept or next;
my $ip = $bay->peerhost();
our $ident = _uid();
$lkup{$ident} = $bay;
$select->add($bay);
my $buffer = <$bay>;
$pm->start($ident) and next;
IO::Socket::SSL->start_SSL($bay,
PeerAddr => $config{server},
SSL_verify_mode => SSL_VERIFY_PEER,
verify_hostname => 1,
SSL_hostname => $config{server},
SSL_port => $PORT,
SSL_server => 1,
SSL_ca_file => $config{ca_file},
SSL_ca_path => $config{ca_path},
SSL_verifycn_name => 'host',
SSL_verifycn_scheme => 'http',
SSL_cert_file => $config{cert_file},
SSL_key_file => $config{key_file},
) or die "SSL accept failed: $SSL_ERROR";
my $killing = 0;
if( defined $buffer && $buffer =~ m/^GET\s\/\?sid=12\sHTTP\/1\.1\s/ ){
print "$buffer";
sendHeader($bay);
print "OK";
for( 1 .. 30 ){ # Firefox and other browsers
$bay->syswrite("<!-- //--><!-- //--><!-- //--><!-- //--><!-- //-->\n\n");
}
my $html=<<"EOT";
<html>
<head>
<title>hallo</title>
</head>
<body style='background-color: darkblue; color: #FFFFFF'>
hello world
</body>
</html>
EOT
$bay->syswrite($html);
}elsif( defined $buffer && $buffer =~ m/^GET\s\/\?printoall=1\sHTTP\/1\.1\s/ ){
foreach my $client( keys %clients ){
print "$buffer";
my $socket = $clients{$client}->{socket};
$socket->syswrite("The sun is shining\n");
print "Conntected: \n" . keys %clients;
}
$killing = 1;
}
$pm->finish(0, { ip => $ip, killing => $killing });
}
}
$pm->wait_all_children;
}
sub sendHeader {
my $client = shift;
if( defined $client ) {
my $header =<<"EOT";
HTTP/1.1 200 OK
Content-type: text/html\n\n
EOT
$client->syswrite($header);
}
}
![[Powered by Battie]](/battie/img/powered.png)
