Schrift
Start · Board · Anwendungen/Programme/Skripte in Perl · Netzwerkprogrammierung und Netzwerke mit Perl
[thread]4464[/thread]

Simpler Threaded Server: ...und ich find den fehler nicht...

Leser: 2


<< >> 6 Einträge, 1 Seite
Gast Gast
 2007-05-18 11:56
#37557 #37557
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
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
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
#!/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;
    }
}
jan
 2007-05-18 12:11
#37558 #37558
User since
2003-08-04
2536 Artikel
ModeratorIn
[Homepage] [default_avatar]
syntax error at server.pl line 100, near "'CODE' {"

Code: (dl )
unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE' {


da fehlt eine schließende runde klammer. am besten hinter 'CODE'

Code: (dl )
unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') {


syntax error at server.pl line 116, near "}"

hier ist wohl eine geschwungene klammer zu viel. die in zeile 114 kann ich nicht zuordnen.

Code: (dl )
1
2
3
4
        open (STDIN, "<&CLIENT")    || die "cant dup client to stdin";
        open (STDOUT, ">&CLIENT")    || die "cant dup client ti stdout";
        exit &$coderef();
-->     }  <--


dadurch wird die sub abgeschlossen und die nächste klammer, die die sub eigentlich abschließen sollte, wird zum problem.
MisterL
 2007-05-18 12:31
#37559 #37559
User since
2006-07-05
334 Artikel
BenutzerIn
[default_avatar]
Also zwei Klammerfehler könnte ich herausmachen (Zeile 100 und 122)
Danach gab es trotzdem eine Fehlermeldung:
perl datei.pl
main::server() called too early to check prototype at datei.pl line 139.

Und einen FTP-Clienten habe ich gerade auch nicht, deswegen:
Code: (dl )
1
2
3
4
5
6
7
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");
}


Vielleicht bringt es dennoch weiter ;-)
“Perl is the only language that looks the same before and after RSA encryption.”
jan
 2007-05-18 12:40
#37560 #37560
User since
2003-08-04
2536 Artikel
ModeratorIn
[Homepage] [default_avatar]
mh ... liegt das nicht einfach an den klammern?
also
Code: (dl )
sub server() {
=>
Code: (dl )
sub server {


da sonst angenommen wird, dass du prototypen willst?
MisterL
 2007-05-18 12:54
#37561 #37561
User since
2006-07-05
334 Artikel
BenutzerIn
[default_avatar]
Danach kompiliert das Programm zwar ohne Fehler, aber es tut sonst nichts weiteres....
“Perl is the only language that looks the same before and after RSA encryption.”
FlorianL
 2007-05-18 13:49
#37562 #37562
User since
2007-05-18
142 Artikel
BenutzerIn
[default_avatar]
Vielen dank für eure 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
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
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
153
154
155
#!/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
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
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
#!/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:
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
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]#
<< >> 6 Einträge, 1 Seite



View all threads created 2007-05-18 11:56.