View | Details | Raw Unified | Return to bug 15338
Collapse All | Expand All

(-)a/misc/bin/SIPServer (-149 / +177 lines)
Lines 15-30 use C4::SIP::Sip::Checksum qw(checksum verify_cksum); Link Here
15
use C4::SIP::Sip::MsgType qw( handle login_core );
15
use C4::SIP::Sip::MsgType qw( handle login_core );
16
use C4::SIP::Sip qw( read_SIP_packet );
16
use C4::SIP::Sip qw( read_SIP_packet );
17
17
18
# or use Net::Server::Fork for better use of resources
18
use base qw(Net::Server::PreFork);
19
use base qw(Net::Server::PreFork);
19
20
20
use constant LOG_SIP => "local6"; # Local alias for the logging facility
21
use constant LOG_SIP => "local6";    # Local alias for the logging facility
21
22
#
23
# Main	# not really, since package SIPServer
24
#
25
# FIXME: Is this a module or a script?
26
# A script with no MAIN namespace?
27
# A module that takes command line args?
28
22
29
my %transports = (
23
my %transports = (
30
    RAW    => \&raw_transport,
24
    RAW    => \&raw_transport,
Lines 40-46 my @parms; Link Here
40
#
34
#
41
# Ports to bind
35
# Ports to bind
42
#
36
#
43
foreach my $svc (keys %{$config->{listeners}}) {
37
foreach my $svc ( keys %{ $config->{listeners} } ) {
44
    push @parms, "port=" . $svc;
38
    push @parms, "port=" . $svc;
45
}
39
}
46
40
Lines 53-79 foreach my $svc (keys %{$config->{listeners}}) { Link Here
53
#
47
#
54
# The IDENT is determined by config file 'server-params' arguments
48
# The IDENT is determined by config file 'server-params' arguments
55
49
56
57
#
50
#
58
# Server Management: set parameters for the Net::Server::PreFork
51
# Server Management: set parameters for the Net::Server
59
# module.  The module silently ignores parameters that it doesn't
52
# module.  The module silently ignores parameters that it doesn't
60
# recognize, and complains about invalid values for parameters
53
# recognize, and complains about invalid values for parameters
61
# that it does.
54
# that it does.
62
#
55
#
63
if (defined($config->{'server-params'})) {
56
if ( defined( $config->{'server-params'} ) ) {
64
    while (my ($key, $val) = each %{$config->{'server-params'}}) {
57
    while ( my ( $key, $val ) = each %{ $config->{'server-params'} } ) {
65
		push @parms, $key . '=' . $val;
58
        push @parms, $key . '=' . $val;
66
    }
59
    }
67
}
60
}
68
61
69
70
#
62
#
71
# This is the main event.
63
# This is the main event.
72
__PACKAGE__ ->run(@parms);
64
__PACKAGE__->run(@parms);
73
74
#
75
# Child
76
#
77
65
78
# process_request is the callback used by Net::Server to handle
66
# process_request is the callback used by Net::Server to handle
79
# an incoming connection request.
67
# an incoming connection request.
Lines 81-87 __PACKAGE__ ->run(@parms); Link Here
81
sub process_request {
69
sub process_request {
82
    my $self = shift;
70
    my $self = shift;
83
    my $service;
71
    my $service;
84
    my ($sockaddr, $port, $proto);
72
    my ( $sockaddr, $port, $proto );
85
    my $transport;
73
    my $transport;
86
74
87
    $self->{config} = $config;
75
    $self->{config} = $config;
Lines 90-118 sub process_request { Link Here
90
78
91
    # Check if socket connection is IPv6 before resolving address
79
    # Check if socket connection is IPv6 before resolving address
92
    my $family = Socket::sockaddr_family($sockname);
80
    my $family = Socket::sockaddr_family($sockname);
93
    if ($family == AF_INET6) {
81
    if ( $family == AF_INET6 ) {
94
      ($port, $sockaddr) = sockaddr_in6($sockname);
82
        ( $port, $sockaddr ) = sockaddr_in6($sockname);
95
      $sockaddr = Socket::inet_ntop(AF_INET6, $sockaddr);
83
        $sockaddr = Socket::inet_ntop( AF_INET6, $sockaddr );
96
    } else {
84
    }
97
      ($port, $sockaddr) = sockaddr_in($sockname);
85
    else {
98
      $sockaddr = inet_ntoa($sockaddr);
86
        ( $port, $sockaddr ) = sockaddr_in($sockname);
87
        $sockaddr = inet_ntoa($sockaddr);
99
    }
88
    }
100
    $proto = $self->{server}->{client}->NS_proto();
89
    $proto = $self->{server}->{client}->NS_proto();
101
90
102
    $self->{service} = $config->find_service($sockaddr, $port, $proto);
91
    $self->{service} = $config->find_service( $sockaddr, $port, $proto );
103
92
104
    if (!defined($self->{service})) {
93
    if ( !defined( $self->{service} ) ) {
105
		syslog("LOG_ERR", "process_request: Unknown recognized server connection: %s:%s/%s", $sockaddr, $port, $proto);
94
        syslog( "LOG_ERR",
106
		die "process_request: Bad server connection";
95
            "process_request: Unknown recognized server connection: %s:%s/%s",
96
            $sockaddr, $port, $proto );
97
        die "process_request: Bad server connection";
107
    }
98
    }
108
99
109
    $transport = $transports{$self->{service}->{transport}};
100
    $transport = $transports{ $self->{service}->{transport} };
110
101
111
    if (!defined($transport)) {
102
    if ( !defined($transport) ) {
112
		syslog("LOG_WARNING", "Unknown transport '%s', dropping", $service->{transport});
103
        syslog( "LOG_WARNING", "Unknown transport '%s', dropping",
113
		return;
104
            $service->{transport} );
114
    } else {
105
        return;
115
		&$transport($self);
106
    }
107
    else {
108
        &$transport($self);
116
    }
109
    }
117
}
110
}
118
111
Lines 125-233 sub raw_transport { Link Here
125
    my ($input);
118
    my ($input);
126
    my $service = $self->{service};
119
    my $service = $self->{service};
127
120
128
    while (!$self->{account}) {
121
    while ( !$self->{account} ) {
129
    local $SIG{ALRM} = sub { die "raw_transport Timed Out!\n"; };
122
        local $SIG{ALRM} = sub { die "raw_transport Timed Out!\n"; };
130
    syslog("LOG_DEBUG", "raw_transport: timeout is %d", $service->{timeout});
123
        syslog( "LOG_DEBUG", "raw_transport: timeout is %d",
131
    $input = read_SIP_packet(*STDIN);
124
            $service->{timeout} );
132
    if (!$input) {
125
        $input = read_SIP_packet(*STDIN);
133
        # EOF on the socket
126
        if ( !$input ) {
134
        syslog("LOG_INFO", "raw_transport: shutting down: EOF during login");
127
135
        return;
128
            # EOF on the socket
136
    }
129
            syslog( "LOG_INFO",
137
    $input =~ s/[\r\n]+$//sm;	# Strip off trailing line terminator(s)
130
                "raw_transport: shutting down: EOF during login" );
138
    last if C4::SIP::Sip::MsgType::handle($input, $self, LOGIN);
131
            return;
132
        }
133
        $input =~ s/[\r\n]+$//sm;    # Strip off trailing line terminator(s)
134
        last if C4::SIP::Sip::MsgType::handle( $input, $self, LOGIN );
139
    }
135
    }
140
136
141
    syslog("LOG_DEBUG", "raw_transport: uname/inst: '%s/%s'",
137
    syslog(
142
	   $self->{account}->{id},
138
        "LOG_DEBUG",            "raw_transport: uname/inst: '%s/%s'",
143
	   $self->{account}->{institution});
139
        $self->{account}->{id}, $self->{account}->{institution}
140
    );
144
141
145
    $self->sip_protocol_loop();
142
    $self->sip_protocol_loop();
146
    syslog("LOG_INFO", "raw_transport: shutting down");
143
    syslog( "LOG_INFO", "raw_transport: shutting down" );
147
}
144
}
148
145
149
sub get_clean_string {
146
sub get_clean_string {
150
	my $string = shift;
147
    my $string = shift;
151
	if (defined $string) {
148
    if ( defined $string ) {
152
		syslog("LOG_DEBUG", "get_clean_string  pre-clean(length %s): %s", length($string), $string);
149
        syslog( "LOG_DEBUG", "get_clean_string  pre-clean(length %s): %s",
153
		chomp($string);
150
            length($string), $string );
154
		$string =~ s/^[^A-z0-9]+//;
151
        chomp($string);
155
		$string =~ s/[^A-z0-9]+$//;
152
        $string =~ s/^[^A-z0-9]+//;
156
		syslog("LOG_DEBUG", "get_clean_string post-clean(length %s): %s", length($string), $string);
153
        $string =~ s/[^A-z0-9]+$//;
157
	} else {
154
        syslog( "LOG_DEBUG", "get_clean_string post-clean(length %s): %s",
158
		syslog("LOG_INFO", "get_clean_string called on undefined");
155
            length($string), $string );
159
	}
156
    }
160
	return $string;
157
    else {
158
        syslog( "LOG_INFO", "get_clean_string called on undefined" );
159
    }
160
    return $string;
161
}
161
}
162
162
163
sub get_clean_input {
163
sub get_clean_input {
164
	local $/ = "\012";
164
    local $/ = "\012";
165
	my $in = <STDIN>;
165
    my $in = <STDIN>;
166
	$in = get_clean_string($in);
166
    $in = get_clean_string($in);
167
	while (my $extra = <STDIN>){
167
    while ( my $extra = <STDIN> ) {
168
		syslog("LOG_ERR", "get_clean_input got extra lines: %s", $extra);
168
        syslog( "LOG_ERR", "get_clean_input got extra lines: %s", $extra );
169
	}
169
    }
170
	return $in;
170
    return $in;
171
}
171
}
172
172
173
sub telnet_transport {
173
sub telnet_transport {
174
    my $self = shift;
174
    my $self = shift;
175
    my ($uid, $pwd);
175
    my ( $uid, $pwd );
176
    my $strikes = 3;
176
    my $strikes = 3;
177
    my $account = undef;
177
    my $account = undef;
178
    my $input;
178
    my $input;
179
    my $config  = $self->{config};
179
    my $config = $self->{config};
180
	my $timeout = $self->{service}->{timeout} || $config->{timeout} || 30;
180
    my $timeout = $self->{service}->{timeout} || $config->{timeout} || 30;
181
	syslog("LOG_DEBUG", "telnet_transport: timeout is %s", $timeout);
181
    syslog( "LOG_DEBUG", "telnet_transport: timeout is %s", $timeout );
182
182
183
    eval {
183
    eval {
184
	local $SIG{ALRM} = sub { die "telnet_transport: Timed Out ($timeout seconds)!\n"; };
184
        local $SIG{ALRM} =
185
	local $| = 1;			# Unbuffered output
185
          sub { die "telnet_transport: Timed Out ($timeout seconds)!\n"; };
186
	$/ = "\015";		# Internet Record Separator (lax version)
186
        local $| = 1;    # Unbuffered output
187
    # Until the terminal has logged in, we don't trust it
187
        $/ = "\015";     # Internet Record Separator (lax version)
188
    # so use a timeout to protect ourselves from hanging.
188
                         # Until the terminal has logged in, we don't trust it
189
189
                         # so use a timeout to protect ourselves from hanging.
190
	while ($strikes--) {
190
191
	    print "login: ";
191
        while ( $strikes-- ) {
192
		alarm $timeout;
192
            print "login: ";
193
		# $uid = &get_clean_input;
193
            alarm $timeout;
194
		$uid = <STDIN>;
194
195
	    print "password: ";
195
            # $uid = &get_clean_input;
196
	    # $pwd = &get_clean_input || '';
196
            $uid = <STDIN>;
197
		$pwd = <STDIN>;
197
            print "password: ";
198
		alarm 0;
198
199
199
            # $pwd = &get_clean_input || '';
200
		syslog("LOG_DEBUG", "telnet_transport 1: uid length %s, pwd length %s", length($uid), length($pwd));
200
            $pwd = <STDIN>;
201
		$uid = get_clean_string ($uid);
201
            alarm 0;
202
		$pwd = get_clean_string ($pwd);
202
203
		syslog("LOG_DEBUG", "telnet_transport 2: uid length %s, pwd length %s", length($uid), length($pwd));
203
            syslog( "LOG_DEBUG",
204
204
                "telnet_transport 1: uid length %s, pwd length %s",
205
	    if (exists ($config->{accounts}->{$uid})
205
                length($uid), length($pwd) );
206
		&& ($pwd eq $config->{accounts}->{$uid}->{password})) {
206
            $uid = get_clean_string($uid);
207
			$account = $config->{accounts}->{$uid};
207
            $pwd = get_clean_string($pwd);
208
			if ( C4::SIP::Sip::MsgType::login_core($self,$uid,$pwd) ) {
208
            syslog( "LOG_DEBUG",
209
                last;
209
                "telnet_transport 2: uid length %s, pwd length %s",
210
                length($uid), length($pwd) );
211
212
            if ( exists( $config->{accounts}->{$uid} )
213
                && ( $pwd eq $config->{accounts}->{$uid}->{password} ) )
214
            {
215
                $account = $config->{accounts}->{$uid};
216
                if ( C4::SIP::Sip::MsgType::login_core( $self, $uid, $pwd ) ) {
217
                    last;
218
                }
210
            }
219
            }
211
	    }
220
            syslog(
212
		syslog("LOG_WARNING", "Invalid login attempt: '%s'", ($uid||''));
221
                "LOG_WARNING",
213
		print("Invalid login$CRLF");
222
                "Invalid login attempt: '%s'",
214
	}
223
                ( $uid || '' )
215
    }; # End of eval
224
            );
225
            print("Invalid login$CRLF");
226
        }
227
    };    # End of eval
216
228
217
    if ($@) {
229
    if ($@) {
218
		syslog("LOG_ERR", "telnet_transport: Login timed out");
230
        syslog( "LOG_ERR", "telnet_transport: Login timed out" );
219
		die "Telnet Login Timed out";
231
        die "Telnet Login Timed out";
220
    } elsif (!defined($account)) {
232
    }
221
		syslog("LOG_ERR", "telnet_transport: Login Failed");
233
    elsif ( !defined($account) ) {
222
		die "Login Failure";
234
        syslog( "LOG_ERR", "telnet_transport: Login Failed" );
223
    } else {
235
        die "Login Failure";
224
		print "Login OK.  Initiating SIP$CRLF";
236
    }
237
    else {
238
        print "Login OK.  Initiating SIP$CRLF";
225
    }
239
    }
226
240
227
    $self->{account} = $account;
241
    $self->{account} = $account;
228
    syslog("LOG_DEBUG", "telnet_transport: uname/inst: '%s/%s'", $account->{id}, $account->{institution});
242
    syslog( "LOG_DEBUG", "telnet_transport: uname/inst: '%s/%s'",
243
        $account->{id}, $account->{institution} );
229
    $self->sip_protocol_loop();
244
    $self->sip_protocol_loop();
230
    syslog("LOG_INFO", "telnet_transport: shutting down");
245
    syslog( "LOG_INFO", "telnet_transport: shutting down" );
231
}
246
}
232
247
233
#
248
#
Lines 236-250 sub telnet_transport { Link Here
236
# telnet transport.  From that point on, both the raw and the telnet
251
# telnet transport.  From that point on, both the raw and the telnet
237
# processes are the same:
252
# processes are the same:
238
sub sip_protocol_loop {
253
sub sip_protocol_loop {
239
	my $self = shift;
254
    my $self    = shift;
240
	my $service = $self->{service};
255
    my $service = $self->{service};
241
	my $config  = $self->{config};
256
    my $config  = $self->{config};
242
    my $timeout = $self->{service}->{client_timeout} || $config->{client_timeout};
257
    my $timeout =
243
	my $input;
258
      $self->{service}->{client_timeout} || $config->{client_timeout};
259
    my $input;
244
260
245
    # The spec says the first message will be:
261
    # The spec says the first message will be:
246
	# 	SIP v1: SC_STATUS
262
    # 	SIP v1: SC_STATUS
247
	# 	SIP v2: LOGIN (or SC_STATUS via telnet?)
263
    # 	SIP v2: LOGIN (or SC_STATUS via telnet?)
248
    # But it might be SC_REQUEST_RESEND.  As long as we get
264
    # But it might be SC_REQUEST_RESEND.  As long as we get
249
    # SC_REQUEST_RESEND, we keep waiting.
265
    # SC_REQUEST_RESEND, we keep waiting.
250
266
Lines 252-262 sub sip_protocol_loop { Link Here
252
    # constraint, so we'll relax about it too.
268
    # constraint, so we'll relax about it too.
253
    # Using the SIP "raw" login process, rather than telnet,
269
    # Using the SIP "raw" login process, rather than telnet,
254
    # requires the LOGIN message and forces SIP 2.00.  In that
270
    # requires the LOGIN message and forces SIP 2.00.  In that
255
	# case, the LOGIN message has already been processed (above).
271
    # case, the LOGIN message has already been processed (above).
256
	#
272
    #
257
	# In short, we'll take any valid message here.
273
    # In short, we'll take any valid message here.
258
	#my $expect = SC_STATUS;
274
    #my $expect = SC_STATUS;
259
    local $SIG{ALRM} = sub { die "SIP Timed Out!\n"; } if $timeout;
275
    local $SIG{ALRM} = sub { die "SIP Timed Out!\n"; }
276
      if $timeout;
260
    my $expect = '';
277
    my $expect = '';
261
    while (1) {
278
    while (1) {
262
        if ($timeout) {
279
        if ($timeout) {
Lines 264-296 sub sip_protocol_loop { Link Here
264
        }
281
        }
265
        $input = read_SIP_packet(*STDIN);
282
        $input = read_SIP_packet(*STDIN);
266
        unless ($input) {
283
        unless ($input) {
267
            return;		# EOF
284
            return;    # EOF
268
        }
285
        }
269
		# begin input hacks ...  a cheap stand in for better Telnet layer
286
270
		$input =~ s/^[^A-z0-9]+//s;	# Kill leading bad characters... like Telnet handshakers
287
        # begin input hacks ...  a cheap stand in for better Telnet layer
271
		$input =~ s/[^A-z0-9]+$//s;	# Same on the end, should get DOSsy ^M line-endings too.
288
        $input =~ s/^[^A-z0-9]+//s
272
		while (chomp($input)) {warn "Extra line ending on input";}
289
          ;            # Kill leading bad characters... like Telnet handshakers
273
		unless ($input) {
290
        $input =~ s/[^A-z0-9]+$//s
274
            syslog("LOG_ERR", "sip_protocol_loop: empty input skipped");
291
          ;            # Same on the end, should get DOSsy ^M line-endings too.
292
        while ( chomp($input) ) { warn "Extra line ending on input"; }
293
        unless ($input) {
294
            syslog( "LOG_ERR", "sip_protocol_loop: empty input skipped" );
275
            print("96$CR");
295
            print("96$CR");
276
            next;
296
            next;
277
		}
297
        }
278
		# end cheap input hacks
298
279
		my $status = handle($input, $self, $expect);
299
        # end cheap input hacks
280
		if (!$status) {
300
        my $status = handle( $input, $self, $expect );
281
			syslog("LOG_ERR", "sip_protocol_loop: failed to handle %s",substr($input,0,2));
301
        if ( !$status ) {
282
		}
302
            syslog(
283
		next if $status eq REQUEST_ACS_RESEND;
303
                "LOG_ERR",
284
		if ($expect && ($status ne $expect)) {
304
                "sip_protocol_loop: failed to handle %s",
285
			# We received a non-"RESEND" that wasn't what we were expecting.
305
                substr( $input, 0, 2 )
286
		    syslog("LOG_ERR", "sip_protocol_loop: expected %s, received %s, exiting", $expect, $input);
306
            );
287
		}
307
        }
288
		# We successfully received and processed what we were expecting
308
        next if $status eq REQUEST_ACS_RESEND;
289
		$expect = '';
309
        if ( $expect && ( $status ne $expect ) ) {
290
        if ($timeout ) {
310
311
            # We received a non-"RESEND" that wasn't what we were expecting.
312
            syslog( "LOG_ERR",
313
                "sip_protocol_loop: expected %s, received %s, exiting",
314
                $expect, $input );
315
        }
316
317
        # We successfully received and processed what we were expecting
318
        $expect = '';
319
        if ($timeout) {
291
            alarm 0;
320
            alarm 0;
292
        }
321
        }
293
	}
322
    }
294
}
323
}
295
324
296
1;
325
1;
297
- 

Return to bug 15338