File: TCP.pm

package info (click to toggle)
inetsim 1.3.2%2Bdfsg.1-1
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, bullseye, trixie
  • size: 1,684 kB
  • sloc: perl: 13,024; sh: 262; makefile: 18; ansic: 13
file content (104 lines) | stat: -rw-r--r-- 3,424 bytes parent folder | download | duplicates (2)
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
# -*- perl -*-
#
# INetSim::Discard::TCP - A fake TCP discard server
#
# RFC 863 - Discard Protocol
#
# (c)2007-2019 Matthias Eckert, Thomas Hungenberg
#
#############################################################

package INetSim::Discard::TCP;

use strict;
use warnings;
use base qw(INetSim::Discard);



sub configure_hook {
    my $self = shift;

    $self->{server}->{host}   = INetSim::Config::getConfigParameter("Default_BindAddress");   # bind to address
    $self->{server}->{port}   = INetSim::Config::getConfigParameter("Discard_TCP_BindPort");  # bind to port
    $self->{server}->{proto}  = 'tcp';                                                        # TCP protocol
    $self->{server}->{user}   = INetSim::Config::getConfigParameter("Default_RunAsUser");     # user to run as
    $self->{server}->{group}  = INetSim::Config::getConfigParameter("Default_RunAsGroup");    # group to run as
    $self->{server}->{setsid} = 0;                                                            # do not daemonize
    $self->{server}->{no_client_stdout} = 1;                                                  # do not attach client to STDOUT
    $self->{server}->{log_level} = 0;                                                         # do not log anything

    $self->{servicename} = INetSim::Config::getConfigParameter("Discard_TCP_ServiceName");
    $self->{max_childs} = INetSim::Config::getConfigParameter("Default_MaxChilds");
    $self->{timeout} = INetSim::Config::getConfigParameter("Default_TimeOut");
}



sub pre_loop_hook {
    my $self = shift;

    $0 = "inetsim_$self->{servicename}";
    INetSim::Log::MainLog("started (PID $$)", $self->{servicename});
}



sub pre_server_close_hook {
    my $self = shift;

    INetSim::Log::MainLog("stopped (PID $$)", $self->{servicename});
}



sub fatal_hook {
    my $self = shift;

    INetSim::Log::MainLog("failed!", $self->{servicename});
    exit 0;
}



sub process_request {
    my $self = shift;
    my $client = $self->{server}->{client};
    my $rhost = $self->{server}->{peeraddr};
    my $rport = $self->{server}->{peerport};
    my $stat_success = 0;

    INetSim::Log::SubLog("[$rhost:$rport] connect", $self->{servicename}, $$);
    if ($self->{server}->{numchilds} >= $self->{max_childs}) {
        print $client "Maximum number of connections ($self->{max_childs}) exceeded.\n";
        INetSim::Log::SubLog("[$rhost:$rport] Connection refused - maximum number of connections ($self->{max_childs}) exceeded.", $self->{servicename}, $$);
    }
    else {
        eval {
            local $SIG{'ALRM'} = sub { die "TIMEOUT" };
            alarm($self->{timeout});
            while (my $line = <$client>) {
                (defined $line) or next;
                $line =~ s/\A[\r\n]+//g;
                $line =~ s/[\r\n]+\z//g;
                if ($line ne "") {
                    INetSim::Log::SubLog("[$rhost:$rport] recv: $line", $self->{servicename}, $$);
                    $stat_success = 1;
                }
                alarm($self->{timeout});
            }
            alarm(0);
        };
    }
    if ($@ =~ /TIMEOUT/) {
        INetSim::Log::SubLog("[$rhost:$rport] disconnect (timeout)", $self->{servicename}, $$);
    }
    else {
        INetSim::Log::SubLog("[$rhost:$rport] disconnect", $self->{servicename}, $$);
    }
    INetSim::Log::SubLog("[$rhost:$rport] stat: $stat_success", $self->{servicename}, $$);
}


1;
#