Dein Skript muss dazu einen Semaphor setzen. Der wird dann im Client-Prozessschleife ausgelesen.
Dein client.pm muss dazu erweitert werden.
Theoretisch ginge das so:
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
my $PID;
BEGIN {
$PID = getpid();
}
SIG{TERM} = sub __set_semaphor {
open my $sema, '>', "$PID.semaphor";
print $sema 1;
close $sema;
return 1;
};
# bei Terminierung hier Aufräumen, später Dateien etc schließen, was weiß ich was du noch machst...
sub __cleanup {
my $self = shift;
sleep(10);
unlink "$PID.semaphor";
1;
}
sub process {
my $self = shift;
my($cmd, @args);
my $sock = $self->{SOCK};
while(my $line = <$sock>) {
# check for termination semaphore
if ( open my $sema, '<', "$PID.semaphor") {
my $terminated = <$sema>;
if ($terminated =~ /^1/) {
$self->_put("451 4.7.1 Service unavailable - try again later;");
$self->__cleanup();
exit(255); # end client
}
}
$Net::SMTP::Server::Client::DEBUG and print STDOUT $line;
# Clean up.
chomp $line;
$line =~ s/^\s+//;
$line =~ s/\s+$//;
if (!length $line) {
$self->_put("500 Learn to type!");
next;
}
($cmd, @args) = split(/\s+/,$line);
$cmd =~ tr/a-z/A-Z/;
if( !defined $_cmds{$cmd} ) {
$self->_put("500 Learn to type!");
next;
}
return(defined($self->{MSG}) ? 1 : 0) unless
&{$_cmds{$cmd}}($self, \@args);
}
return undef;
}
Ich habe schon länger keinen Server mehr programmiert. Also ist das eher ein Programmiermodell als ein lauffähiges Code im Server. Bitte um Verständnis.
Bei Zweifel kann ja auch jemand noch im Forum sein, der mehr in Perl-Servern macht.
Last edited: 2016-03-30 11:14:38 +0200 (CEST)