From 4458ece5423c9fd4e2256f828377bf2f0000c4c3 Mon Sep 17 00:00:00 2001 From: Colin Campbell Date: Tue, 30 Mar 2021 14:24:09 +0100 Subject: [PATCH] Bug 15338: Fix indentation and comments in SIPServer Supplemental patch which takes advantage of the relocation of the program to apply a consistent indentation to the code also removes comments arising from the confusion resulting from the program's name and location Add a comment indicating that this code will work under other flavours of Net::Server as well as PreFork --- bin/SIPServer | 285 +++++++++++++++++++++++++++----------------------- 1 file changed, 156 insertions(+), 129 deletions(-) diff --git a/bin/SIPServer b/bin/SIPServer index 768888c3d8..804eefec05 100644 --- a/bin/SIPServer +++ b/bin/SIPServer @@ -4,6 +4,7 @@ use strict; use warnings; use FindBin qw($Bin); use lib "$Bin"; +# or use Net::Server::Fork for better use of resources use Net::Server::PreFork; use IO::Socket::INET; use Socket qw(:DEFAULT :crlf); @@ -26,14 +27,7 @@ tie *STDERR, "C4::SIP::Trapper"; use base qw(Net::Server::PreFork); -use constant LOG_SIP => "local6"; # Local alias for the logging facility - -# -# Main # not really, since package SIPServer -# -# FIXME: Is this a module or a script? -# A script with no MAIN namespace? -# A module that takes command line args? +use constant LOG_SIP => "local6"; # Local alias for the logging facility # Set interface to 'sip' C4::Context->interface('sip'); @@ -52,7 +46,7 @@ my @parms; # # Ports to bind # -foreach my $svc (keys %{$config->{listeners}}) { +foreach my $svc ( keys %{ $config->{listeners} } ) { push @parms, "port=" . $svc; } @@ -65,23 +59,21 @@ foreach my $svc (keys %{$config->{listeners}}) { # # The IDENT is determined by config file 'server-params' arguments - # -# Server Management: set parameters for the Net::Server::PreFork +# Server Management: set parameters for the Net::Server::* # module. The module silently ignores parameters that it doesn't # recognize, and complains about invalid values for parameters # that it does. # -if (defined($config->{'server-params'})) { - while (my ($key, $val) = each %{$config->{'server-params'}}) { +if ( defined( $config->{'server-params'} ) ) { + while ( my ( $key, $val ) = each %{ $config->{'server-params'} } ) { push @parms, $key . '=' . $val; } } - # # This is the main event. -__PACKAGE__ ->run(@parms); +__PACKAGE__->run(@parms); # # Child @@ -93,7 +85,7 @@ __PACKAGE__ ->run(@parms); sub process_request { my $self = shift; my $service; - my ($sockaddr, $port, $proto); + my ( $sockaddr, $port, $proto ); my $transport; $self->{config} = $config; @@ -101,35 +93,41 @@ sub process_request { # Flushing L1 to make sure the request will be processed using the correct data Koha::Caches->flush_L1_caches(); - $self->{account} = undef; # Clear out the account from the last request, it may be different + $self->{account} = + undef; # Clear out the account from the last request, it may be different $self->{logger} = set_logger( Koha::Logger->get( { interface => 'sip' } ) ); my $sockname = getsockname(STDIN); # Check if socket connection is IPv6 before resolving address my $family = Socket::sockaddr_family($sockname); - if ($family == AF_INET6) { - ($port, $sockaddr) = sockaddr_in6($sockname); - $sockaddr = Socket::inet_ntop(AF_INET6, $sockaddr); - } else { - ($port, $sockaddr) = sockaddr_in($sockname); - $sockaddr = inet_ntoa($sockaddr); + if ( $family == AF_INET6 ) { + ( $port, $sockaddr ) = sockaddr_in6($sockname); + $sockaddr = Socket::inet_ntop( AF_INET6, $sockaddr ); + } + else { + ( $port, $sockaddr ) = sockaddr_in($sockname); + $sockaddr = inet_ntoa($sockaddr); } $proto = $self->{server}->{client}->NS_proto(); - $self->{service} = $config->find_service($sockaddr, $port, $proto); + $self->{service} = $config->find_service( $sockaddr, $port, $proto ); - if (!defined($self->{service})) { - siplog("LOG_ERR", "process_request: Unknown recognized server connection: %s:%s/%s", $sockaddr, $port, $proto); + if ( !defined( $self->{service} ) ) { + siplog( "LOG_ERR", + "process_request: Unknown recognized server connection: %s:%s/%s", + $sockaddr, $port, $proto ); die "process_request: Bad server connection"; } - $transport = $transports{$self->{service}->{transport}}; + $transport = $transports{ $self->{service}->{transport} }; - if (!defined($transport)) { - siplog("LOG_WARNING", "Unknown transport '%s', dropping", $service->{transport}); + if ( !defined($transport) ) { + siplog( "LOG_WARNING", "Unknown transport '%s', dropping", + $service->{transport} ); return; - } else { + } + else { &$transport($self); } return; @@ -143,29 +141,33 @@ sub raw_transport { my $self = shift; my $input; my $service = $self->{service}; - # If using Net::Server::PreFork you may already have account set from a previous session - # Ensure you dont - if ($self->{account}) { + +# If using Net::Server::PreFork you may already have account set from a previous session +# Ensure you dont + if ( $self->{account} ) { delete $self->{account}; } # Timeout the while loop if we get stuck in it # In practice it should only iterate once but be prepared local $SIG{ALRM} = sub { die 'raw transport Timed Out!' }; - my $timeout = $self->get_timeout({ transport => 1 }); - siplog('LOG_DEBUG', "raw_transport: timeout is $timeout"); + my $timeout = $self->get_timeout( { transport => 1 } ); + siplog( 'LOG_DEBUG', "raw_transport: timeout is $timeout" ); alarm $timeout; - while (!$self->{account}) { + while ( !$self->{account} ) { $input = read_request(); - if (!$input) { + if ( !$input ) { + # EOF on the socket - siplog("LOG_INFO", "raw_transport: shutting down: EOF during login"); + siplog( "LOG_INFO", + "raw_transport: shutting down: EOF during login" ); return; } - $input =~ s/[\r\n]+$//sm; # Strip off trailing line terminator(s) + $input =~ s/[\r\n]+$//sm; # Strip off trailing line terminator(s) my $reg = qr/^${\(LOGIN)}/; - last if $input !~ $reg || - C4::SIP::Sip::MsgType::handle($input, $self, LOGIN); + last + if $input !~ $reg + || C4::SIP::Sip::MsgType::handle( $input, $self, LOGIN ); } alarm 0; @@ -173,34 +175,38 @@ sub raw_transport { Koha::Logger->get( { interface => 'sip', - category => $self->{account}->{id}, # Add id to namespace + category => $self->{account}->{id}, # Add id to namespace } ) ); - siplog("LOG_DEBUG", "raw_transport: uname/inst: '%s/%s'", - $self->{account}->{id}, - $self->{account}->{institution}); - if (! $self->{account}->{id}) { - siplog("LOG_ERR","Login failed shutting down"); + siplog( + "LOG_DEBUG", "raw_transport: uname/inst: '%s/%s'", + $self->{account}->{id}, $self->{account}->{institution} + ); + if ( !$self->{account}->{id} ) { + siplog( "LOG_ERR", "Login failed shutting down" ); return; } $self->sip_protocol_loop(); - siplog("LOG_INFO", "raw_transport: shutting down"); + siplog( "LOG_INFO", "raw_transport: shutting down" ); return; } sub get_clean_string { my $string = shift; - if (defined $string) { - siplog("LOG_DEBUG", "get_clean_string pre-clean(length %s): %s", length($string), $string); + if ( defined $string ) { + siplog( "LOG_DEBUG", "get_clean_string pre-clean(length %s): %s", + length($string), $string ); chomp($string); $string =~ s/^[^A-z0-9]+//; $string =~ s/[^A-z0-9]+$//; - siplog("LOG_DEBUG", "get_clean_string post-clean(length %s): %s", length($string), $string); - } else { - siplog("LOG_INFO", "get_clean_string called on undefined"); + siplog( "LOG_DEBUG", "get_clean_string post-clean(length %s): %s", + length($string), $string ); + } + else { + siplog( "LOG_INFO", "get_clean_string called on undefined" ); } return $string; } @@ -209,70 +215,85 @@ sub get_clean_input { local $/ = "\012"; my $in = ; $in = get_clean_string($in); - while (my $extra = ){ - siplog("LOG_ERR", "get_clean_input got extra lines: %s", $extra); + while ( my $extra = ) { + siplog( "LOG_ERR", "get_clean_input got extra lines: %s", $extra ); } return $in; } sub telnet_transport { my $self = shift; - my ($uid, $pwd); + my ( $uid, $pwd ); my $strikes = 3; my $account = undef; my $input; - my $config = $self->{config}; - my $timeout = $self->get_timeout({ transport => 1 }); - siplog("LOG_DEBUG", "telnet_transport: timeout is $timeout"); + my $config = $self->{config}; + my $timeout = $self->get_timeout( { transport => 1 } ); + siplog( "LOG_DEBUG", "telnet_transport: timeout is $timeout" ); eval { - local $SIG{ALRM} = sub { die "telnet_transport: Timed Out ($timeout seconds)!\n"; }; - local $| = 1; # Unbuffered output - $/ = "\015"; # Internet Record Separator (lax version) - # Until the terminal has logged in, we don't trust it - # so use a timeout to protect ourselves from hanging. - - while ($strikes--) { - print "login: "; - alarm $timeout; - # $uid = &get_clean_input; - $uid = ; - print "password: "; - # $pwd = &get_clean_input || ''; - $pwd = ; - alarm 0; - - siplog("LOG_DEBUG", "telnet_transport 1: uid length %s, pwd length %s", length($uid), length($pwd)); - $uid = get_clean_string ($uid); - $pwd = get_clean_string ($pwd); - siplog("LOG_DEBUG", "telnet_transport 2: uid length %s, pwd length %s", length($uid), length($pwd)); - - if (exists ($config->{accounts}->{$uid}) - && ($pwd eq $config->{accounts}->{$uid}->{password})) { - $account = $config->{accounts}->{$uid}; - if ( C4::SIP::Sip::MsgType::login_core($self,$uid,$pwd) ) { - last; + local $SIG{ALRM} = + sub { die "telnet_transport: Timed Out ($timeout seconds)!\n"; }; + local $| = 1; # Unbuffered output + $/ = "\015"; # Internet Record Separator (lax version) + # Until the terminal has logged in, we don't trust it + # so use a timeout to protect ourselves from hanging. + + while ( $strikes-- ) { + print "login: "; + alarm $timeout; + + # $uid = &get_clean_input; + $uid = ; + print "password: "; + + # $pwd = &get_clean_input || ''; + $pwd = ; + alarm 0; + + siplog( "LOG_DEBUG", + "telnet_transport 1: uid length %s, pwd length %s", + length($uid), length($pwd) ); + $uid = get_clean_string($uid); + $pwd = get_clean_string($pwd); + siplog( "LOG_DEBUG", + "telnet_transport 2: uid length %s, pwd length %s", + length($uid), length($pwd) ); + + if ( exists( $config->{accounts}->{$uid} ) + && ( $pwd eq $config->{accounts}->{$uid}->{password} ) ) + { + $account = $config->{accounts}->{$uid}; + if ( C4::SIP::Sip::MsgType::login_core( $self, $uid, $pwd ) ) { + last; + } } + siplog( + "LOG_WARNING", + "Invalid login attempt: '%s'", + ( $uid || '' ) + ); + print("Invalid login$CRLF"); } - siplog("LOG_WARNING", "Invalid login attempt: '%s'", ($uid||'')); - print("Invalid login$CRLF"); - } - }; # End of eval + }; # End of eval if ($@) { - siplog("LOG_ERR", "telnet_transport: Login timed out"); + siplog( "LOG_ERR", "telnet_transport: Login timed out" ); die "Telnet Login Timed out"; - } elsif (!defined($account)) { - siplog("LOG_ERR", "telnet_transport: Login Failed"); + } + elsif ( !defined($account) ) { + siplog( "LOG_ERR", "telnet_transport: Login Failed" ); die "Login Failure"; - } else { + } + else { print "Login OK. Initiating SIP$CRLF"; } $self->{account} = $account; - siplog("LOG_DEBUG", "telnet_transport: uname/inst: '%s/%s'", $account->{id}, $account->{institution}); + siplog( "LOG_DEBUG", "telnet_transport: uname/inst: '%s/%s'", + $account->{id}, $account->{institution} ); $self->sip_protocol_loop(); - siplog("LOG_INFO", "telnet_transport: shutting down"); + siplog( "LOG_INFO", "telnet_transport: shutting down" ); return; } @@ -282,10 +303,10 @@ sub telnet_transport { # telnet transport. From that point on, both the raw and the telnet # processes are the same: sub sip_protocol_loop { - my $self = shift; + my $self = shift; my $service = $self->{service}; my $config = $self->{config}; - my $timeout = $self->get_timeout({ client => 1 }); + my $timeout = $self->get_timeout( { client => 1 } ); # The spec says the first message will be: # SIP v1: SC_STATUS @@ -339,38 +360,39 @@ sub sip_protocol_loop { } sub read_request { - my $raw_length; - local $/ = "\015"; + my $raw_length; + local $/ = "\015"; # proper SPEC: (octal) \015 = (hex) x0D = (dec) 13 = (ascii) carriage return - my $buffer = ; - if ( defined $buffer ) { - STDIN->flush(); # clear an extra linefeed - chomp $buffer; - $raw_length = length $buffer; - $buffer =~ s/^\s*[^A-z0-9]+//s; + my $buffer = ; + if ( defined $buffer ) { + STDIN->flush(); # clear an extra linefeed + chomp $buffer; + $raw_length = length $buffer; + $buffer =~ s/^\s*[^A-z0-9]+//s; + # Every line must start with a "real" character. Not whitespace, control chars, etc. - $buffer =~ s/[^A-z0-9]+$//s; + $buffer =~ s/[^A-z0-9]+$//s; # Same for the end. Note this catches the problem some clients have sending empty fields at the end, like ||| - $buffer =~ s/\015?\012//g; # Extra line breaks must die - $buffer =~ s/\015?\012//s; # Extra line breaks must die - $buffer =~ s/\015*\012*$//s; + $buffer =~ s/\015?\012//g; # Extra line breaks must die + $buffer =~ s/\015?\012//s; # Extra line breaks must die + $buffer =~ s/\015*\012*$//s; # treat as one line to include the extra linebreaks we are trying to remove! - } - else { - siplog( 'LOG_DEBUG', 'EOF returned on read' ); - return; - } - my $len = length $buffer; - if ( $len != $raw_length ) { - my $trim = $raw_length - $len; - siplog( 'LOG_DEBUG', "read_request trimmed $trim character(s) " ); - } - - siplog( 'LOG_INFO', "INPUT MSG: '$buffer'" ); - return $buffer; + } + else { + siplog( 'LOG_DEBUG', 'EOF returned on read' ); + return; + } + my $len = length $buffer; + if ( $len != $raw_length ) { + my $trim = $raw_length - $len; + siplog( 'LOG_DEBUG', "read_request trimmed $trim character(s) " ); + } + + siplog( 'LOG_INFO', "INPUT MSG: '$buffer'" ); + return $buffer; } # $server->get_timeout({ $type => 1, fallback => $fallback }); @@ -387,30 +409,35 @@ sub get_timeout { my ( $server, $params ) = @_; my $fallback = $params->{fallback} || 30; my $service = $server->{service} // {}; - my $config = $server->{config} // {}; + my $config = $server->{config} // {}; - if( $params->{transport} || - ( $params->{client} && !exists $service->{client_timeout} )) { + if ( $params->{transport} + || ( $params->{client} && !exists $service->{client_timeout} ) ) + { # We do not allow zero values here. # Note: config/timeout seems to be deprecated. return $service->{timeout} || $config->{timeout} || $fallback; - } elsif( $params->{client} ) { + } + elsif ( $params->{client} ) { + # We know that client_timeout exists now. # We do allow zero values here to indicate no timeout. return 0 if $service->{client_timeout} =~ /^0+$|\D/; return $service->{client_timeout}; - } elsif( $params->{policy} ) { + } + elsif ( $params->{policy} ) { my $policy = $server->{policy} // {}; my $rv = sprintf( "%03d", $policy->{timeout} // 0 ); - if( length($rv) != 3 ) { + if ( length($rv) != 3 ) { siplog( "LOG_ERR", "Policy timeout has wrong size: '%s'", $rv ); return '000'; } return $rv; - } else { + } + else { return $fallback; } } -- 2.20.1