Attachment #34858 for bug #13506

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




#
# parse-config: Parse an XML-format
# ACS configuration file and build the configuration
# structure.

use warnings;
use XML::Simple qw(:strict);

my $parser = new XML::Simple(
    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;

    foreach my $acct (values %{$cfg->{accounts}}) {
		new Sip::Configuration::Account $acct;
    }

    # The key to the listeners hash is the 'port' component of the
    # configuration, which is of the form '[host]:[port]/proto', and
    # 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;
		$listeners{lc $service->{port}} = $service;
    }
    $cfg->{listeners} = \%listeners;

    foreach my $inst (values %{$cfg->{institutions}}) {
		new Sip::Configuration::Institution $inst;
    }
    return bless $cfg, $class;
}


    my $self = shift;
    return $self->{'error-detect'};
}

sub accounts {
    my $self = shift;
    return values %{ $self->{accounts} };
}

# sub policy {
#     my $self = shift;
#     return values %{$self->{policy}};
# }

sub find_service {
    my ( $self, $sockaddr, $port, $proto ) = @_;
    my $portstr;
    foreach my $addr ( '', '*:', "$sockaddr:", "[$sockaddr]:" ) {
        $portstr = sprintf( "%s%s/%s", $addr, $port, lc $proto );
        Sys::Syslog::syslog( "LOG_DEBUG",
            "Configuration::find_service: Trying $portstr" );
        last if ( exists( ( $self->{listeners} )->{$portstr} ) );
    }
    return $self->{listeners}->{$portstr};
}

1;
__END__

    my $config = new Sip::Configuration $ARGV[0];


foreach my $acct ($config->accounts) {
    print "Found account '", $acct->name, "', part of '"
    print $acct->institution, "'\n";
}

1;




#
#
#
#

package Sip::Configuration::Account;

use strict;
use warnings;

sub new {
    my ($class, $obj) = @_;
    my $type = ref($class) || $class;

    if (ref($obj) eq "HASH") {
	# Just bless the object
	return bless $obj, $type;
    }

    return bless {}, $type;
}

sub id {
    my $self = shift;
    return $self->{id};
}

sub institution {
    my $self = shift;
    return $self->{institution};
}

sub password {
    my $self = shift;
    return $self->{password};
}

1;




#
#
#
#

package Sip::Configuration::Institution;

use strict;
use warnings;

sub new {
    my ($class, $obj) = @_;
    my $type = ref($class) || $class;

    if (ref($obj) eq "HASH") {
    # Just bless the object
    return bless $obj, $type;
    }

    return bless {}, $type;
}

sub name {
    my $self = shift;
    return $self->{name};
}

sub id {
    my $self = shift;
    return $self->{id};
}

sub implementation {
    my $self = shift;
    return $self->{implementation};
}

sub policy {
    my $self = shift;
    return $self->{policy};
}

# 'policy' => {
#     'checkout' => 'true',
#     'retries' => 5,
#     'checkin' => 'true',
#     'timeout' => 25,
#     'status_update' => 'false',
#     'offline' => 'false',
#     'renewal' => 'true'
# },

sub parms {
    my $self = shift;
    return $self->{parms};
}

1;




#
#
#
#

package Sip::Configuration::Service;

use strict;
use warnings;

sub new {
    my ($class, $obj) = @_;
    my $type = ref($class) || $class;

    if (ref($obj) eq "HASH") {
	# Just bless the object
	return bless $obj, $type;
    }

    return bless {}, $type;
}

1;
- 

Return to bug 13506

Lines 1-4 Link Here

(-)a/C4/SIP/Sip/Configuration.pm (-51 / +31 lines)
1	#	1	#
2	# parse-config: Parse an XML-format	2	# parse-config: Parse an XML-format
3	# ACS configuration file and build the configuration	3	# ACS configuration file and build the configuration
4	# structure.	4	# structure.
Lines 10-56 use strict; Link Here
10	use warnings;	10	use warnings;
11	use XML::Simple qw(:strict);	11	use XML::Simple qw(:strict);
12		12
13	use Sip::Configuration::Institution;	13	my $parser = new XML::Simple(
14	use Sip::Configuration::Account;	14	KeyAttr => {
15	use Sip::Configuration::Service;	15	login => '+id',
16		16	institution => '+id',
17	my $parser = new XML::Simple( KeyAttr => { login => '+id',	17	service => '+port'
18	institution => '+id',	18	},
19	service => '+port' },	19	GroupTags => {
20	GroupTags => { listeners => 'service',	20	listeners => 'service',
21	accounts => 'login',	21	accounts => 'login',
22	institutions => 'institution', },	22	institutions => 'institution',
23	ForceArray=> [ 'service',	23	},
24	'login',	24	ForceArray => [ 'service', 'login', 'institution' ],
25	'institution' ],	25	ValueAttr => {
26	ValueAttr => { 'error-detect' => 'enabled',	26	'error-detect' => 'enabled',
27	'min_servers' => 'value',	27	'min_servers' => 'value',
28	'max_servers' => 'value'} );	28	'max_servers' => 'value'
		29	}
		30	);
29		31
30	sub new {	32	sub new {
31	my ($class, $config_file) = @_;	33	my ( $class, $config_file ) = @_;
32	my $cfg = $parser->XMLin($config_file);	34	my $cfg = $parser->XMLin($config_file);
33	my %listeners;	35	my %listeners;
34		36
35	foreach my $acct (values %{$cfg->{accounts}}) {
36	new Sip::Configuration::Account $acct;
37	}
38
39	# The key to the listeners hash is the 'port' component of the	37	# The key to the listeners hash is the 'port' component of the
40	# configuration, which is of the form '[host]:[port]/proto', and	38	# configuration, which is of the form '[host]:[port]/proto', and
41	# the 'proto' component could be upper-, lower-, or mixed-cased.	39	# the 'proto' component could be upper-, lower-, or mixed-cased.
42	# Regularize it here to lower-case, and then do the same below in	40	# Regularize it here to lower-case, and then do the same below in
43	# find_server() when building the keys to search the hash.	41	# find_server() when building the keys to search the hash.
44		42
45	foreach my $service (values %{$cfg->{listeners}}) {	43	foreach my $service ( values %{ $cfg->{listeners} } ) {
46	new Sip::Configuration::Service $service;	44	$listeners{ lc $service->{port} } = $service;
47	$listeners{lc $service->{port}} = $service;
48	}	45	}
49	$cfg->{listeners} = \%listeners;	46	$cfg->{listeners} = \%listeners;
50		47
51	foreach my $inst (values %{$cfg->{institutions}}) {
52	new Sip::Configuration::Institution $inst;
53	}
54	return bless $cfg, $class;	48	return bless $cfg, $class;
55	}	49	}
56		50
Lines 58-93 sub error_detect { Link Here
58	my $self = shift;	52	my $self = shift;
59	return $self->{'error-detect'};	53	return $self->{'error-detect'};
60	}	54	}
		55
61	sub accounts {	56	sub accounts {
62	my $self = shift;	57	my $self = shift;
63	return values %{$self->{accounts}};	58	return values %{ $self->{accounts} };
64	}	59	}
65		60
66	# sub policy {
67	# my $self = shift;
68	# return values %{$self->{policy}};
69	# }
70
71	sub find_service {	61	sub find_service {
72	my ($self, $sockaddr, $port, $proto) = @_;	62	my ( $self, $sockaddr, $port, $proto ) = @_;
73	my $portstr;	63	my $portstr;
74	foreach my $addr ('', '*:', "$sockaddr:", "[$sockaddr]:") {	64	foreach my $addr ( '', '*:', "$sockaddr:", "[$sockaddr]:" ) {
75	$portstr = sprintf("%s%s/%s", $addr, $port, lc $proto);	65	$portstr = sprintf( "%s%s/%s", $addr, $port, lc $proto );
76	Sys::Syslog::syslog("LOG_DEBUG", "Configuration::find_service: Trying $portstr");	66	Sys::Syslog::syslog( "LOG_DEBUG",
77	last if (exists(($self->{listeners})->{$portstr}));	67	"Configuration::find_service: Trying $portstr" );
78	}	68	last if ( exists( ( $self->{listeners} )->{$portstr} ) );
		69	}
79	return $self->{listeners}->{$portstr};	70	return $self->{listeners}->{$portstr};
80	}	71	}
81		72
82	1;	73	1;
83	__END__
84
85	my $config = new Sip::Configuration $ARGV[0];
86
87
88	foreach my $acct ($config->accounts) {
89	print "Found account '", $acct->name, "', part of '"
90	print $acct->institution, "'\n";
91	}
92
93	1;

Lines 1-38 Link Here

(-)a/C4/SIP/Sip/Configuration/Account.pm (-38 lines)
1	#
2	#
3	#
4	#
5
6	package Sip::Configuration::Account;
7
8	use strict;
9	use warnings;
10
11	sub new {
12	my ($class, $obj) = @_;
13	my $type = ref($class) \|\| $class;
14
15	if (ref($obj) eq "HASH") {
16	# Just bless the object
17	return bless $obj, $type;
18	}
19
20	return bless {}, $type;
21	}
22
23	sub id {
24	my $self = shift;
25	return $self->{id};
26	}
27
28	sub institution {
29	my $self = shift;
30	return $self->{institution};
31	}
32
33	sub password {
34	my $self = shift;
35	return $self->{password};
36	}
37
38	1;

Lines 1-58 Link Here

(-)a/C4/SIP/Sip/Configuration/Institution.pm (-58 lines)
1	#
2	#
3	#
4	#
5
6	package Sip::Configuration::Institution;
7
8	use strict;
9	use warnings;
10
11	sub new {
12	my ($class, $obj) = @_;
13	my $type = ref($class) \|\| $class;
14
15	if (ref($obj) eq "HASH") {
16	# Just bless the object
17	return bless $obj, $type;
18	}
19
20	return bless {}, $type;
21	}
22
23	sub name {
24	my $self = shift;
25	return $self->{name};
26	}
27
28	sub id {
29	my $self = shift;
30	return $self->{id};
31	}
32
33	sub implementation {
34	my $self = shift;
35	return $self->{implementation};
36	}
37
38	sub policy {
39	my $self = shift;
40	return $self->{policy};
41	}
42
43	# 'policy' => {
44	# 'checkout' => 'true',
45	# 'retries' => 5,
46	# 'checkin' => 'true',
47	# 'timeout' => 25,
48	# 'status_update' => 'false',
49	# 'offline' => 'false',
50	# 'renewal' => 'true'
51	# },
52
53	sub parms {
54	my $self = shift;
55	return $self->{parms};
56	}
57
58	1;

Lines 1-23 Link Here

(-)a/C4/SIP/Sip/Configuration/Service.pm (-24 lines)
1	#
2	#
3	#
4	#
5
6	package Sip::Configuration::Service;
7
8	use strict;
9	use warnings;
10
11	sub new {
12	my ($class, $obj) = @_;
13	my $type = ref($class) \|\| $class;
14
15	if (ref($obj) eq "HASH") {
16	# Just bless the object
17	return bless $obj, $type;
18	}
19
20	return bless {}, $type;
21	}
22
23	1;
24	-