Thread <STDIN> funktioniert nicht (4 answers)
Opened by Gast at 2007-06-13 15:17

bloonix
 2007-06-14 13:22
#37573 #37573
User since
2005-12-17
1615 Artikel
HausmeisterIn
[Homepage]
user image
Hi, wie im IRC versprochen hab ich dir was schnell zusammen gehackt.
Es läuft auch bei mir auf Windows XP und funktioniert einwandfrei.
Öffne einfach 3 Command-Boxen. Starte in einer Box den Server und in
den beiden anderen den Client. Es funktionieren nur die Kommandos
"date" und "exit".

client.pl
Code: (dl )
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
use strict;
use warnings;
use IO::Socket::INET;

$|++;

my $socket = IO::Socket::INET->new(
  PeerAddr => '127.0.0.1',
  PeerPort => 50010,
  Proto    => 'tcp',
  Type     => SOCK_STREAM,
) or die "client: can't connect to 127.0.0.1:50010";

print STDOUT "I'm connected to the server\n#> ";

while (my $request = <STDIN>) {
  chomp $request;
  if (length($request)) {
     print $socket $request, "\n";
     last if $request eq 'exit';
     my $response = <$socket>;
     chomp $response;
     print $response, "\n";
  }
  print STDOUT "#> ";
}

close $socket;
print STDOUT "Connection closed\n";


server.pl
Code: (dl )
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
use strict;
use warnings;
use Log::Handler;
use IO::Socket::INET;

my $log = Log::Handler->new(
  filename => \*STDOUT,
  newline  => 1,
  maxlevel => 'info',
  prefix   => "[<--LEVEL-->] server($$) ",
);

my $socket = IO::Socket::INET->new(
  LocalHost  => '127.0.0.1',
  LocalPort  => 50010,
  Type       => SOCK_STREAM,
  Listen     => 10,
  Reuse      => 1,
) or die "server: can't open socket over port 50010";

my %commands = (
  date => \&timestamp,
);

while (my $client = $socket->accept()) {
  my $peerhost = $client->peerhost;
  my $peerport = $client->peerport;
  $log->info("reqeust from client $peerhost on port $peerport");
  $log->info("forking a child now");
  my $pid = fork; # der Server wird geforkt
  next if $pid;   # der Server springt zum Anfang der Schleife

  # ---------------------------------------------------------
  # das ist der Child
  # ---------------------------------------------------------
  $log->set_prefix("[<--LEVEL-->] child($$) peerhost($peerhost) peerport($peerport): ");
  $log->info("i'm startet");

  while (my $request = <$client>) {
     chomp $request;
     if ($request eq 'exit') {
        $log->info("client closed connection");
        last;
     } elsif ($request =~ /^\w+\z/ && exists $commands{$request}) {
        $log->info("client request: $request");
        my $response = $commands{$request}();
        print $client $response, "\n";
     } else {
        $log->warn("bad request from client");
        print $client "bad command\n";
     }
  }

  close $client;
  exit unless $pid; # exit, damit $socket ausserhalb der Schleife nicht geschlossen wird
  # ---------------------------------------------------------
}

close($socket);

sub timestamp {
  my @t = (localtime)[reverse 0..5];
  $t[0] += 1900;
  $t[1] += 1;
  return sprintf '%02d:%02d:%02d %02d.%02d.%04d', @t[3..5], reverse @t[0..2];
}


Beide Skripts könnte man natürlich noch besser schreiben, aber rein fürs
lernen reicht das erstmal. Du solltest das natürlich einzig auf localhost
testen und auf keinen Fall auf eine IP, auf die auch andere Zugriff haben
könnten!! Da greifst du besser auf SSH oder sonstige Tools zurück.\n\n

<!--EDIT|opi|1181813007-->
What is a good module? That's hard to say.
What is good code? That's also hard to say.
One man's Thing of Beauty is another's man's Evil Hack.

View full thread <STDIN> funktioniert nicht