Threaded Server Script

[FlorianL]

Hallo zusammen, ich bin relativ neu dabei was perl angeht und habe zur übung mit einem kleinen script angefangen was in eine datei schreibt, das wurde dann durch einen simplen server erweitert, und nun bin ich (mit hilfe eines beispiel-scripts) daran threads mit einzubauen...
ich bekomme beim ausführen des scripts diese Fehler:

$ perl server.pl
syntax error at server.pl line 100, near "'CODE' {"
syntax error at server.pl line 116, near "}"
Execution of server.pl aborted due compilation errors.

ich sitz jetzt schon 2 stunden dran, hab einiges hin und herprobiert aber ich packs nich... Vieleicht schaut einer von euch ma drüber und sieht auf den ersten blick meinen fehler :)
(die hoffnung stirbt zuletzt *g*)

server.pl

#!/usr/bin/perl#Simples Server konstrukt by FlorianL ;)use strict;require 5.002;use warnings;use IO::Socket;use Carp;my $cfgfile = "serverconfig.cfg";my $keyfile = ".key.file";my ($port, $username, $choosed, $coderef);sub logmsg {print "$0 $$: @_ at ", scalar localtime, "\n" }sub spawn;sub genpass { print ("\nGenerating KeyFile\nEnter your Password: "); chomp (my $password = <STDIN>); my @chars = ("A" .. "Z"); my $salt = join("", @chars[ map {rand @chars } (1 .. 2) ]); our $crypted = crypt("$password", "$salt"); open(KEYFILE,">$keyfile") or die "Error: Cant write the Keyfile"; print KEYFILE chomp($crypted); close (KEYFILE); print ("\nHash = $crypted\n"); system("chmod 666 $keyfile"); print ("Keyfile saved to $keyfile!\nPermissions set to 666\nUpload it to your Clients now!\n");}sub readconfig() { open(CONFIG,$cfgfile) or die "Error: Cant open $cfgfile"; my @config=<CONFIG>; close(CONFIG); chomp($port = $config[0]); if ($port eq "") { die ("Error: No Port specified"); } chomp($username = $config[1]); if ($username eq "") { die ("Error: No Username specified"); }}sub writeconfig() { print ("Config\n------\n"); print ("\nPort: "); my $port = <STDIN>; if ($port =~ m/[a-z]+/) { die ("Port must be a number!"); } print ("\nUsername: "); my $username = <STDIN>; print ("Config written to $cfgfile\n"); my @config = ($port, $username,); open(CONFIG,">$cfgfile"); print CONFIG (@config); close (CONFIG); if (-z "$keyfile") { print ("No KeyFile present, well we generate one now...\n"); genpass(); } else { print ("KeyFile allready present!\n"); }}sub server() { readconfig(); my $proto = getprotobyname('tcp'); socket(SERVER, PF_INET, SOCK_STREAM, $proto) || die "FAILED: socket: $!"; setsockopt(SERVER, SOL_SOCKET, SO_REUSEADDR, pack ("l", 1)) || die "FAILED: setsockopt: $!"; bind(SERVER, sockaddr_in($port, INADDR_ANY)) || die "FAILED: bind: $!"; listen(SERVER, SOMAXCONN) || die "FAILED: listen: $!"; logmsg "Server started on Port $port"; my $waitedpid = 0; my $paddr; sub KILLER { our $waitedpid = wait; $SIG{CHLD} = \&KILLER; logmsg "Killed $waitedpid" . ($? ? " with exit $?" : ''); } $SIG{CHLD} = \&KILLER; for ($waitedpid = 0; ($paddr = accept(CLIENT,SERVER)) || $waitedpid; $waitedpid = 0, close CLIENT) { next if $waitedpid and not $paddr; my ($port,$iaddr) = sockaddr_in($paddr); my $name = gethostbyaddr($iaddr,AF_INET); logmsg "Connection from $name [", inet_ntoa($iaddr), "] at port $port"; spawn sub { print "Hello there, $name\n"; }; } sub spawn { my $coderef = shift; unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE' { confess "usage: spawn CODEREF"; } my $pid; if (!defined($pid = fork)) { logmsg "cannot fork: $!"; return; } elsif ($pid) { logmsg "begat $pid"; return; } open (STDIN, "<&CLIENT") || die "cant dup client to stdin"; open (STDOUT, ">&CLIENT") || die "cant dup client ti stdout"; exit &$coderef(); } }sub help() { print ("Valid commandline Options are:\n"); print ("-config -Initiates Configuration\n"); print ("-printcfg -Print Config\n"); print ("-server -Starts the Server\n"); print ("-genpass -Generates a new keyfile (1st-timers: Use -config instead!\n");}main {$choosed = $ARGV[0];if ($choosed eq '-config') { writeconfig(); exit 0;} elsif ($choosed eq '-printcfg') { readconfig(); print ("Port: $port"); print ("Username: $username"); exit 0;} elsif ($choosed eq '-genpass') { genpass(); exit 0;} elsif ($choosed eq '-server') { server(); exit 0;} else { help(); exit 0; }}

omg, mir hats die formatierung zerhaun, das script liegt aber auch noch >hier< (http://doorgunner2.dc-gmbh.de/server.txt)

[eViL_oNe]

das sind simple Syntaxfehler. In Zeile 100 fehlt die schließende runde Klammer. In Zeile 115 ist eine geschweifte, schließende Klammer zuviel, das verursacht den zweiten Fehler


sub spawn {
my $coderef = shift;
unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') {
confess "usage: spawn CODEREF";
}
my $pid;
if (!defined($pid = fork)) {
logmsg "cannot fork: $!";
return;
} elsif ($pid) {
logmsg "begat $pid";
return;
}
open (STDIN, "<&CLIENT") || die "cant dup client to stdin";
open (STDOUT, ">&CLIENT") || die "cant dup client ti stdout";
exit &$coderef();
}


edit: im übrigen ist was mit der Klammersetzung bei anderen unterprogrammen missglückt -- sub server und sub KILLER werden irgendwie nicht korrekt wieder durch geschweifte Klammern beendet, was einen Fehler "missing right curly bracket at EOF" zur Folge hat.

[FlorianL]

Vielen dank für die schnelle hilfe! :)

Also.. es läuft nun an, aber tut nich wirklich was ich will :/
Und zwar sollte er eigendlich die verbindung aufrecht erhalten und in die server funktion zurückfallen, stattdessen wird das prog aber komplett gekilled... Ausserdem weiss ich nicht wie ich jetzt weiter machen soll was die kommunikation zwischen server und client angeht, der client sendet zwar raus, aber wie kann ich im serverscript ne variable festlegen in die der input vom client kommt, gespeichert wird (strg+f: $authresponse)? Und die abfrage müsste ich doch dann per while schleife konstruieren oder?
so sieht es im moment aus:

Server.pl
#!/usr/bin/perl
#Simples Server konstrukt by FlorianL;)
use strict;
require 5.002;
use warnings;
use IO::Socket;
use Carp;
my $cfgfile = "serverconfig.cfg";
my $keyfile = ".key.file";
my ($port, $username, $choosed, $coderef, $crypted);
sub logmsg {print "$0 $$: @_ at ", scalar localtime, "\n" }
sub spawn;
sub genpass {
print ("\nGenerating KeyFile\nEnter your Password: ");
chomp (my $password = <STDIN>);
my @chars = ("A" .. "Z");
my $salt = join("", @chars[ map {rand @chars } (1 .. 2) ]);
$crypted = crypt("$password", "$salt");
open(KEYFILE,">$keyfile") or die "Error: Cant write the Keyfile";
print KEYFILE $crypted;
close (KEYFILE);
print ("\nHash = $crypted\n");
system("chmod 666 $keyfile");
print ("Keyfile saved to $keyfile!\nPermissions set to 666\nUpload it to your Clients now!\n");
}
sub readconfig() {
open(CONFIG,$cfgfile) or die "Error: Cant open $cfgfile";
my @config=<CONFIG>;
close(CONFIG);
chomp($port = $config[0]);
if ($port eq "") { die ("Error: No Port specified"); }
chomp($username = $config[1]);
if ($username eq "") { die ("Error: No Username specified"); }
}
sub writeconfig() {
print ("Config\n------\n");
print ("\nPort: ");
my $port = <STDIN>;
if ($port =~ m/[a-z]+/) { die ("Port must be a number!"); }
print ("\nUsername: ");
my $username = <STDIN>;
print ("Config written to $cfgfile\n");
my @config = ($port, $username,);
open(CONFIG,">$cfgfile");
print CONFIG (@config);
close (CONFIG);
open(KEYFILE,">$keyfile");
if (-z "$keyfile") {
print ("No KeyFile present, well we generate one now...\n");
genpass();
} else {
print ("KeyFile allready present!\n");
}
close(KEYFILE);
}
sub server() {
readconfig();
my $proto = getprotobyname('tcp');
socket(SERVER, PF_INET, SOCK_STREAM, $proto) || die "FAILED: socket: $!";
setsockopt(SERVER, SOL_SOCKET, SO_REUSEADDR, pack ("l", 1)) || die "FAILED: setsockopt: $!";
bind(SERVER, sockaddr_in($port, INADDR_ANY)) || die "FAILED: bind: $!";
listen(SERVER, SOMAXCONN) || die "FAILED: listen: $!";
logmsg "Server started on Port $port";
my $waitedpid = 0;
my $paddr;
sub KILLER {
our $waitedpid = wait;
$SIG{CHLD} = \&KILLER;
logmsg "Killed $waitedpid" . ($? ? " with exit $?" : '');
}
$SIG{CHLD} = \&KILLER;
for ($waitedpid = 0;
($paddr = accept(CLIENT,SERVER)) || $waitedpid;
$waitedpid = 0, close CLIENT)
{
next if $waitedpid and not $paddr;
my ($port,$iaddr) = sockaddr_in($paddr);
my $name = gethostbyaddr($iaddr,AF_INET);
logmsg "Connection from",inet_ntoa($iaddr);
spawn sub {
print "CONNECT\n";
open(KEYFILE,$keyfile);
my $crypt = <KEYFILE>;
close(KEYFILE);
my $authresponse = '';
if ($authresponse eq $crypt) {
print "AUTHED\n";
} else {
print "DENIED\n";
}
}
}
sub spawn {
my $coderef = shift;
unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') {
confess "usage: spawn CODEREF";
}
my $pid;
if (!defined($pid = fork)) {
logmsg "cannot fork: $!";
return;
} elsif ($pid) {
logmsg "forked $pid";
return;
}
open (STDIN, "<&CLIENT") || die "cant dup client to stdin";
open (STDOUT, ">&CLIENT") || die "cant dup client ti stdout";
exit &$coderef();
}
}
sub help() {
print ("Valid commandline Options are:\n");
print ("-config -Initiates Configuration\n");
print ("-printcfg -Print Config\n");
print ("-server -Starts the Server\n");
print ("-genpass -Generates a new keyfile \(1st-timers: Use -config instead!\)\n");
}
main {
$choosed = $ARGV[0];
if ($choosed eq '-config') {
writeconfig();
exit 0;
} elsif ($choosed eq '-printcfg') {
readconfig();
print ("Port: $port");
print ("Username: $username");
exit 0;
} elsif ($choosed eq '-genpass') {
genpass();
exit 0;
} elsif ($choosed eq '-server') {
server();
exit 0;
} else {
help();
exit 0;
}
}


client.pl

#!/usr/bin/perl
use strict;
use warnings;
use IO::Socket;
my ($server, $port, $keyfile, $choosed);
sub readconfig() {
open(CONFIG,"config.cfg") or die "Error: Cant open config.cfg";
my @config=<CONFIG>;
close(CONFIG);
chomp($server = $config[0]);
if ($server eq "") { die ("Error: No Server specified"); }
chomp($port = $config[1]);
if ($port eq "") { die ("Error: No Port specified"); }
chomp($keyfile = $config[2]);
if ($keyfile eq "") { die ("Error: No Keyfile specified"); }
}
sub writeconfig() {
print ("Config\n------\n");
print ("Server: ");
my $server = <STDIN>;
print ("\nPort: ");
my $port = <STDIN>;
if ($port =~ m/[a-z]+/) { die ("Port must be a number!"); }
print ("\nKeyfile: ");
my $keyfile = <STDIN>;
print ("Config written to config.cfg\n");
my @config = ($server, $port, $keyfile);
open(CONFIG,">config.cfg");
print CONFIG (@config);
close (CONFIG);
}
sub connection() {
readconfig();
my $remote = IO::Socket::INET->new (
Proto => 'tcp',
PeerAddr => $server,
PeerPort => $port,
Reuse => 1,
) or die "$!n";
print ("Connected to ", $remote->peerhost, " on port ",$remote->peerport, "\n\n");
$remote->autoflush(1);
while ($remote) {
my $line = <$remote>;
open(KEYFILE,$keyfile);
my $crypt = <KEYFILE>;
close(KEYFILE);
if ($remote eq 'AUTH') {
print $remote "$crypt";
} elsif ($remote eq 'AUTHED') {
print $remote "TEST";
} else {
print "Communication failed, exiting...\n";
exit;
}
}
close $remote;
}

sub help() {
print ("Valid commandline Options are:\n");
print ("-config -Initiates Configuration\n");
print ("-printcfg -Print Config\n");
print ("-connect -Connects to the Server\n");
}
$choosed = $ARGV[0];
if ($choosed eq '-config') {
writeconfig();
exit 0;
} elsif ($choosed eq '-printcfg') {
readconfig();
print ("Server: $server");
print ("Port: $port");
print ("Keyfile: $keyfile");
exit 0;
} elsif ($choosed eq '-connect') {
connection();
exit 0;
} else {
help();
exit 0;
}

Output:

Server:
[root@doorgunner scripts]# perl server.pl -server
server.pl 18904: Server started on Port 1337 at Fri May 18 11:32:44 2007
server.pl 18904: Connection from 127.0.0.1 at Fri May 18 11:32:47 2007
server.pl 18904: forked 18906 at Fri May 18 11:32:47 2007
server.pl 18904: Killed 18906 with exit 256 at Fri May 18 11:32:47 2007
[root@doorgunner scripts]#
Client:
[root@doorgunner scripts]# perl client.pl -connect
Connected to 127.0.0.1 on port 1337
Communication failed, exiting...
[root@doorgunner scripts]#

Netcat:
[root@doorgunner scripts]# nc localhost 1337
CONNECT
DENIED
[root@doorgunner scripts]#

[kill4h`]

Also im Moment forkst du ihn ja nur soweit ich das beim Überfliegen gesehn habe. Und sowas wie while(true) oder for( ; ; ) hab ich auch grad nich gesehn. Du baust normalerweise ne Schleife wie etwa sowas:
while(accept(DEIN_CLIENT, DEIN SERVER))Damit kannst du dir dann die Commands in ne Variable legen lassen, musst ja nur noch vom Socket lesen.

Wenn du wirklich Threads willst/brauchst, dann wirf doch mal nen Blick auf die Perl Module Thread, Thread::Queue und Thread::Semaphore. Alle zu finden im CPAN afaik, sogar incl. Manual.

Edit:
Ich sehe grad, du nutzt IO::Socket. Dann kannst du auch das hier machen:
while($client = $remote->accept())

[FlorianL]

Also im Moment forkst du ihn ja nur soweit ich das beim Überfliegen gesehn habe. Und sowas wie while(true) oder for( ; ; ) hab ich auch grad nich gesehn. Du baust normalerweise ne Schleife wie etwa sowas:
while(accept(DEIN_CLIENT, DEIN SERVER))Damit kannst du dir dann die Commands in ne Variable legen lassen, musst ja nur noch vom Socket lesen.

Wenn du wirklich Threads willst/brauchst, dann wirf doch mal nen Blick auf die Perl Module Thread, Thread::Queue und Thread::Semaphore. Alle zu finden im CPAN afaik, sogar incl. Manual.

Edit:
Ich sehe grad, du nutzt IO::Socket. Dann kannst du auch das hier machen:
while($client = $remote->accept())


So schauts im moment aus, leider funktioniert die zuweisung der vom client übergebenen werte nicht, und ich weiss nicht wieso?!


#!/usr/bin/perl

#Simples Server konstrukt by FlorianL ;)

use strict;
require 5.002;
use warnings;
use IO::Socket;
use IO::Select;
use Carp;

my $version = "0.1beta";

my $cfgfile = "serverconfig.cfg";
my $keyfile = ".key.file";

my ($port, $username, $choosed, $coderef, $crypted, $clientline);
my (@hash);

sub logmsg {print "$0 $$: @_ at ", scalar localtime, "\n" }
sub spawn;

sub genpass {
print ("\nGenerating KeyFile\nEnter your Password: ");
chomp (my $password = <STDIN>);
my @chars = ("A" .. "Z");
my $salt = join("", @chars[ map {rand @chars } (1 .. 2) ]);
$crypted = crypt("$password", "$salt");
open(KEYFILE,">$keyfile") or die "Error: Cant write the Keyfile";
print KEYFILE $crypted;
close (KEYFILE);
print ("\nHash = $crypted\nSalt: $salt\n");
system("chmod 600 $keyfile");
print ("\nKeyfile saved to $keyfile!\nPermissions set to 600 \(Owner Read\/Write\)\nUpload it to your Clients now!\n");
}

sub readconfig() {
open(CONFIG,$cfgfile) or die "Error: Cant open $cfgfile";
my @config=<CONFIG>;
close(CONFIG);
chomp($port = $config[0]);
if ($port eq "") { die ("Error: No Port specified"); }
chomp($username = $config[1]);
if ($username eq "") { die ("Error: No Username specified"); }
}

sub writeconfig() {
print ("Config\n------\n");
print ("\nPort: ");
my $port = <STDIN>;
if ($port =~ m/[a-z]+/) { die ("Port must be a number!"); }
print ("\nUsername: ");
my $username = <STDIN>;
print ("Config written to $cfgfile\n");
my @config = ($port, $username,);
open(CONFIG,">$cfgfile");
print CONFIG (@config);
close (CONFIG);
open(KEYFILE,">$keyfile");
if (-z $keyfile) {
print ("No KeyFile present, well we generate one now...\n");
genpass();
} else {
print ("KeyFile allready present!\n");
}
close(KEYFILE);
}

sub server() {
readconfig(); # Config einlesen
open(PASSFILE,$keyfile) || die "No Keyfile found!\n";
@hash = <PASSFILE>; # Hash auslesen und zuweisen
close(PASSFILE);

my $server = IO::Socket::INET->new(
LocalPort => $port,
type => SOCK_STREAM,
Reuse => 1,
Listen => 10
) or die "Couldnt start Server: $@\n";

print ("Waiting for Clients...\n");

my $select = IO::Select->new($server);
while (my @readable = $select->can_read) {
for my $socket (@readable) {
if ($socket == $server) {
print "Client connected\n";
my $client = $socket->accept;
$select->add($client);
print $client "CONNECT"; # Server sendet CONNECT
} else {
my $line = $socket->getline;
if (defined $line) {
$line =~ s!\r?\n$!!g;
if (lc($line) eq 'quit') { # Wenn client quit sendet, socket killen
print "Client gone\n";
delete_socket($select, $socket);
} elsif (lc($line) eq @hash) { # Wenn @hash mit keyfile ünstimmt, AUTHED an client senden
$socket->print("AUTHED");
} else {
print "Client: [$line]\n"; # Sonstiges wird auf der cmdline ausgegeben
}
} else {
print "Connection closed by client\n"; # Connection closed...
delete_socket($select, $socket);
}
}
}
}
sub delete_socket {
my ($sel, $sock) = @_;
$sel->remove($sock);
$sock->close();
}
}

sub help() {
print ("Valid commandline Options are:\n");
print ("-config -Initiates Configuration\n");
print ("-printcfg -Print Config\n");
print ("-server -Starts the Server\n");
print ("-genpass -Generates a new keyfile \(1st-timers: Use -config instead!\)\n");
print ("-version -Shows the Version\n");
}

main {
print ("----------------------------------------\n");
print ("| |\n");
print ("| Simple Server by F.Luettgens |\n");
print ("| |\n");
print ("----------------------------------------\n\n");

$choosed = $ARGV[0];
if ($choosed eq '-config') {
writeconfig();
exit 0;
} elsif ($choosed eq '-printcfg') {
readconfig();
print ("\nPort: $port\n");
print ("\nUsername: $username\n");
exit 0;
} elsif ($choosed eq '-genpass') {
genpass();
exit 0;
} elsif ($choosed eq '-server') {
server();
exit 0;
} elsif ($choosed eq '-version') {
print ("You are using version $version\n");;
exit 0;
} else {
help();
exit 0;
}
}




jemand ne idee warum die nicht zugewiesen werden können?