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

(-)a/C4/SIP/SIPServer.pm (-34 / +73 lines)
Lines 15-21 use C4::SIP::Sip::Constants qw(:all); Link Here
15
use C4::SIP::Sip::Configuration;
15
use C4::SIP::Sip::Configuration;
16
use C4::SIP::Sip::Checksum qw(checksum verify_cksum);
16
use C4::SIP::Sip::Checksum qw(checksum verify_cksum);
17
use C4::SIP::Sip::MsgType qw( handle login_core );
17
use C4::SIP::Sip::MsgType qw( handle login_core );
18
use C4::SIP::Sip qw( read_SIP_packet );
19
18
20
use base qw(Net::Server::PreFork);
19
use base qw(Net::Server::PreFork);
21
20
Lines 116-121 sub process_request { Link Here
116
    } else {
115
    } else {
117
		&$transport($self);
116
		&$transport($self);
118
    }
117
    }
118
    return;
119
}
119
}
120
120
121
#
121
#
Lines 130-136 sub raw_transport { Link Here
130
    while (!$self->{account}) {
130
    while (!$self->{account}) {
131
    local $SIG{ALRM} = sub { die "raw_transport Timed Out!\n"; };
131
    local $SIG{ALRM} = sub { die "raw_transport Timed Out!\n"; };
132
    syslog("LOG_DEBUG", "raw_transport: timeout is %d", $service->{timeout});
132
    syslog("LOG_DEBUG", "raw_transport: timeout is %d", $service->{timeout});
133
    $input = read_SIP_packet(*STDIN);
133
    $input = read_request();
134
    if (!$input) {
134
    if (!$input) {
135
        # EOF on the socket
135
        # EOF on the socket
136
        syslog("LOG_INFO", "raw_transport: shutting down: EOF during login");
136
        syslog("LOG_INFO", "raw_transport: shutting down: EOF during login");
Lines 146-151 sub raw_transport { Link Here
146
146
147
    $self->sip_protocol_loop();
147
    $self->sip_protocol_loop();
148
    syslog("LOG_INFO", "raw_transport: shutting down");
148
    syslog("LOG_INFO", "raw_transport: shutting down");
149
    return;
149
}
150
}
150
151
151
sub get_clean_string {
152
sub get_clean_string {
Lines 230-235 sub telnet_transport { Link Here
230
    syslog("LOG_DEBUG", "telnet_transport: uname/inst: '%s/%s'", $account->{id}, $account->{institution});
231
    syslog("LOG_DEBUG", "telnet_transport: uname/inst: '%s/%s'", $account->{id}, $account->{institution});
231
    $self->sip_protocol_loop();
232
    $self->sip_protocol_loop();
232
    syslog("LOG_INFO", "telnet_transport: shutting down");
233
    syslog("LOG_INFO", "telnet_transport: shutting down");
234
    return;
233
}
235
}
234
236
235
#
237
#
Lines 242-248 sub sip_protocol_loop { Link Here
242
	my $service = $self->{service};
244
	my $service = $self->{service};
243
	my $config  = $self->{config};
245
	my $config  = $self->{config};
244
    my $timeout = $self->{service}->{timeout} || $config->{timeout} || 30;
246
    my $timeout = $self->{service}->{timeout} || $config->{timeout} || 30;
245
	my $input;
246
247
247
    # The spec says the first message will be:
248
    # The spec says the first message will be:
248
	# 	SIP v1: SC_STATUS
249
	# 	SIP v1: SC_STATUS
Lines 257-295 sub sip_protocol_loop { Link Here
257
	# case, the LOGIN message has already been processed (above).
258
	# case, the LOGIN message has already been processed (above).
258
	# 
259
	# 
259
	# In short, we'll take any valid message here.
260
	# In short, we'll take any valid message here.
260
	#my $expect = SC_STATUS;
261
    eval {
261
    local $SIG{ALRM} = sub { die "SIP Timed Out!\n"; };
262
        local $SIG{ALRM} = sub {
262
    my $expect = '';
263
            syslog( 'LOG_DEBUG', 'Inactive: timed out' );
263
    while (1) {
264
            die "Timed Out!\n";
264
        alarm $timeout;
265
        };
265
        $input = read_SIP_packet(*STDIN);
266
        my $previous_alarm = alarm($timeout);
266
        unless ($input) {
267
267
            return;		# EOF
268
        while ( my $inputbuf = read_request() ) {
269
            if ( !defined $inputbuf ) {
270
                return;    #EOF
271
            }
272
            alarm($timeout);
273
274
            unless ($inputbuf) {
275
                syslog( "LOG_ERR", "sip_protocol_loop: empty input skipped" );
276
                print("96$CR");
277
                next;
278
            }
279
280
            my $status = C4::SIP::Sip::MsgType::handle( $inputbuf, $self, q{} );
281
            if ( !$status ) {
282
                syslog(
283
                    "LOG_ERR",
284
                    "sip_protocol_loop: failed to handle %s",
285
                    substr( $inputbuf, 0, 2 )
286
                );
287
            }
288
            next if $status eq REQUEST_ACS_RESEND;
268
        }
289
        }
269
		# begin input hacks ...  a cheap stand in for better Telnet layer
290
        alarm($previous_alarm);
270
		$input =~ s/^[^A-z0-9]+//s;	# Kill leading bad characters... like Telnet handshakers
291
        return;
271
		$input =~ s/[^A-z0-9]+$//s;	# Same on the end, should get DOSsy ^M line-endings too.
292
    };
272
		while (chomp($input)) {warn "Extra line ending on input";}
293
    if ( $@ =~ m/timed out/i ) {
273
		unless ($input) {
294
        return;
274
            syslog("LOG_ERR", "sip_protocol_loop: empty input skipped");
295
    }
275
            print("96$CR");
296
    return;
276
            next;
277
		}
278
		# end cheap input hacks
279
		my $status = handle($input, $self, $expect);
280
		if (!$status) {
281
			syslog("LOG_ERR", "sip_protocol_loop: failed to handle %s",substr($input,0,2));
282
		}
283
		next if $status eq REQUEST_ACS_RESEND;
284
		if ($expect && ($status ne $expect)) {
285
			# We received a non-"RESEND" that wasn't what we were expecting.
286
		    syslog("LOG_ERR", "sip_protocol_loop: expected %s, received %s, exiting", $expect, $input);
287
		}
288
		# We successfully received and processed what we were expecting
289
		$expect = '';
290
    alarm 0;
291
	}
292
}
297
}
293
298
299
sub read_request {
300
      my $raw_length;
301
      local $/ = "\015";
302
303
    # proper SPEC: (octal) \015 = (hex) x0D = (dec) 13 = (ascii) carriage return
304
      my $buffer = <STDIN>;
305
      if ( defined $buffer ) {
306
          STDIN->flush();    # clear an extra linefeed
307
          chomp $buffer;
308
          $raw_length = length $buffer;
309
          $buffer =~ s/^\s*[^A-z0-9]+//s;
310
# Every line must start with a "real" character.  Not whitespace, control chars, etc.
311
          $buffer =~ s/[^A-z0-9]+$//s;
312
313
# Same for the end.  Note this catches the problem some clients have sending empty fields at the end, like |||
314
          $buffer =~ s/\015?\012//g;    # Extra line breaks must die
315
          $buffer =~ s/\015?\012//s;    # Extra line breaks must die
316
          $buffer =~ s/\015*\012*$//s;
317
318
    # treat as one line to include the extra linebreaks we are trying to remove!
319
      }
320
      else {
321
          syslog( 'LOG_DEBUG', 'EOF returned on read' );
322
          return;
323
      }
324
      my $len = length $buffer;
325
      if ( $len != $raw_length ) {
326
          my $trim = $raw_length - $len;
327
          syslog( 'LOG_DEBUG', "read_request trimmed $trim character(s) " );
328
      }
329
330
      syslog( 'LOG_INFO', "INPUT MSG: '$buffer'" );
331
      return $buffer;
332
}
294
1;
333
1;
295
__END__
334
__END__
(-)a/C4/SIP/Sip.pm (-56 / +1 lines)
Lines 22-35 BEGIN { Link Here
22
	@ISA = qw(Exporter);
22
	@ISA = qw(Exporter);
23
23
24
	@EXPORT_OK = qw(y_or_n timestamp add_field maybe_add add_count
24
	@EXPORT_OK = qw(y_or_n timestamp add_field maybe_add add_count
25
		    denied sipbool boolspace write_msg read_SIP_packet
25
		    denied sipbool boolspace write_msg
26
		    $error_detection $protocol_version $field_delimiter
26
		    $error_detection $protocol_version $field_delimiter
27
		    $last_response);
27
		    $last_response);
28
28
29
	%EXPORT_TAGS = (
29
	%EXPORT_TAGS = (
30
		    all => [qw(y_or_n timestamp add_field maybe_add
30
		    all => [qw(y_or_n timestamp add_field maybe_add
31
			       add_count denied sipbool boolspace write_msg
31
			       add_count denied sipbool boolspace write_msg
32
			       read_SIP_packet
33
			       $error_detection $protocol_version
32
			       $error_detection $protocol_version
34
			       $field_delimiter $last_response)]);
33
			       $field_delimiter $last_response)]);
35
}
34
}
Lines 154-212 sub boolspace { Link Here
154
    return $bool ? 'Y' : ' ';
153
    return $bool ? 'Y' : ' ';
155
}
154
}
156
155
157
158
# read_SIP_packet($file)
159
#
160
# Read a packet from $file, using the correct record separator
161
#
162
sub read_SIP_packet {
163
    my $record;
164
    my $fh = shift or syslog("LOG_ERR", "read_SIP_packet: no filehandle argument!");
165
    my $len1 = 999;
166
167
    # local $/ = "\r";      # don't need any of these here.  use whatever the prevailing $/ is.
168
    local $/ = "\015";    # proper SPEC: (octal) \015 = (hex) x0D = (dec) 13 = (ascii) carriage return
169
    {    # adapted from http://perldoc.perl.org/5.8.8/functions/readline.html
170
            undef $!;
171
            $record = readline($fh);
172
            if ( defined($record) ) {
173
                while ( chomp($record) ) { 1; }
174
                $len1 = length($record);
175
                syslog( "LOG_DEBUG", "read_SIP_packet, INPUT MSG: '$record'" );
176
                $record =~ s/^\s*[^A-z0-9]+//s; # Every line must start with a "real" character.  Not whitespace, control chars, etc. 
177
                $record =~ s/[^A-z0-9]+$//s;    # Same for the end.  Note this catches the problem some clients have sending empty fields at the end, like |||
178
                $record =~ s/\015?\012//g;      # Extra line breaks must die
179
                $record =~ s/\015?\012//s;      # Extra line breaks must die
180
                $record =~ s/\015*\012*$//s;    # treat as one line to include the extra linebreaks we are trying to remove!
181
                while ( chomp($record) ) { 1; }
182
183
                $record and last;    # success
184
            }
185
    }
186
    if ($record) {
187
        my $len2 = length($record);
188
        syslog("LOG_INFO", "read_SIP_packet, INPUT MSG: '$record'") if $record;
189
        ($len1 != $len2) and syslog("LOG_DEBUG", "read_SIP_packet, trimmed %s character(s) (after chomps).", $len1-$len2);
190
    } else {
191
        syslog("LOG_WARNING", "read_SIP_packet input %s, end of input.", (defined($record) ? "empty ($record)" : 'undefined'));
192
    }
193
    #
194
    # Cen-Tec self-check terminals transmit '\r\n' line terminators.
195
    # This is actually very hard to deal with in perl in a reasonable
196
    # since every OTHER piece of hardware out there gets the protocol
197
    # right.
198
    # 
199
    # The incorrect line terminator presents as a \r at the end of the
200
    # first record, and then a \n at the BEGINNING of the next record.
201
    # So, the simplest thing to do is just throw away a leading newline
202
    # on the input.
203
    #  
204
    # This is now handled by the vigorous cleansing above.
205
    # syslog("LOG_INFO", encode_utf8("INPUT MSG: '$record'")) if $record;
206
    syslog("LOG_INFO", "INPUT MSG: '$record'") if $record;
207
    return $record;
208
}
209
210
#
156
#
211
# write_msg($msg, $file)
157
# write_msg($msg, $file)
212
#
158
#
213
- 

Return to bug 13807