Marcel de Rooy
fcd7e884bc
Signed-off-by: Marcel de Rooy <m.de.rooy@rijksmuseum.nl> Signed-off-by: Martin Renvoize <martin.renvoize@ptfs-europe.com>
87 lines
2.5 KiB
Perl
87 lines
2.5 KiB
Perl
#
|
|
# parse-config: Parse an XML-format
|
|
# ACS configuration file and build the configuration
|
|
# structure.
|
|
#
|
|
|
|
package C4::SIP::Sip::Configuration;
|
|
|
|
use strict;
|
|
use warnings;
|
|
use XML::Simple qw(:strict);
|
|
use List::MoreUtils qw(uniq);
|
|
|
|
use C4::SIP::Sip qw(siplog);
|
|
use Koha::Libraries;
|
|
|
|
my $parser = XML::Simple->new(
|
|
KeyAttr => {
|
|
login => '+id',
|
|
institution => '+id',
|
|
service => '+port'
|
|
},
|
|
GroupTags => {
|
|
listeners => 'service',
|
|
accounts => 'login',
|
|
institutions => 'institution',
|
|
},
|
|
ForceArray => [ 'service', 'login', 'institution' ],
|
|
ValueAttr => {
|
|
'error-detect' => 'enabled',
|
|
'min_servers' => 'value',
|
|
'max_servers' => 'value'
|
|
}
|
|
);
|
|
|
|
sub new {
|
|
my ( $class, $config_file ) = @_;
|
|
my $cfg = $parser->XMLin($config_file);
|
|
my %listeners;
|
|
|
|
# The key to the listeners hash is the 'port' component of the
|
|
# configuration, which is of the form '[host]:[port]/proto[/IPv[46]]'
|
|
# The 'proto' component could be upper-, lower-, or mixed-cased.
|
|
# Regularize it here to lower-case, and then do the same below in
|
|
# find_server() when building the keys to search the hash.
|
|
|
|
foreach my $service ( values %{ $cfg->{listeners} } ) {
|
|
$listeners{ lc $service->{port} } = $service;
|
|
}
|
|
$cfg->{listeners} = \%listeners;
|
|
|
|
my @branchcodes = Koha::Libraries->search()->get_column('branchcode');
|
|
my @institutions = uniq( keys %{ $cfg->{institutions} } );
|
|
foreach my $i ( @institutions ) {
|
|
siplog("LOG_ERR", "ERROR: Institution $i does does not match a branchcode. This can cause unexpected behavior.") unless grep( /^$i$/, @branchcodes );
|
|
}
|
|
|
|
return bless $cfg, $class;
|
|
}
|
|
|
|
sub error_detect {
|
|
my $self = shift;
|
|
return $self->{'error-detect'};
|
|
}
|
|
|
|
sub accounts {
|
|
my $self = shift;
|
|
return values %{ $self->{accounts} };
|
|
}
|
|
|
|
sub find_service {
|
|
my ( $self, $sockaddr, $port, $proto ) = @_;
|
|
my $portstr;
|
|
foreach my $addr ( '', '*:', "$sockaddr:", "[$sockaddr]:" ) {
|
|
$portstr = sprintf( "%s%s/%s", $addr, $port, lc $proto );
|
|
siplog( "LOG_DEBUG",
|
|
"Configuration::find_service: Trying $portstr" );
|
|
last if ( exists( ( $self->{listeners} )->{$portstr} ) );
|
|
$portstr .= '/ipv4'; # lc, see ->new
|
|
last if ( exists( ( $self->{listeners} )->{$portstr} ) );
|
|
$portstr .= '/ipv6'; # lc, see ->new
|
|
last if ( exists( ( $self->{listeners} )->{$portstr} ) );
|
|
}
|
|
return $self->{listeners}->{$portstr};
|
|
}
|
|
|
|
1;
|