#!/usr/bin/perl
use
POSIX
qw/:sys_wait_h/
;
my
$debug
= 0;
my
$version
=
'0.1.0_dev190'
;
sub
debug($);
sub
usage($);
sub
version();
sub
read_config($ $);
MAIN:
{
my
(
$fname
);
my
%opts
;
getopts(
'f:hs:Vv'
, \
%opts
) or usage 1;
version
if
$opts
{V};
usage 0
if
$opts
{h};
exit
0
if
$opts
{V} ||
$opts
{h};
$debug
=
$opts
{v};
if
(!
defined
$opts
{f}) {
warn
"No configuration file specified\n"
;
usage 1;
}
usage 1
if
@ARGV
;
Net::SixXS::diag(Net::SixXS::Diag::MainDebug->new());
my
$cfg
= read_config
$opts
{f}, [
qw/username password/
];
my
$tic
= Net::SixXS::TIC::Client->new(
username
=>
$cfg
->{username},
password
=>
$cfg
->{password}) or
die
"Could not create the TIC client object\n"
;
$tic
->client_name(
$tic
->client_name.
'-tic-tunnels'
);
$tic
->client_version(
$version
);
$tic
->server(
$opts
{s} //
'localhost'
);
debug
"About to connect to TIC server "
.
$tic
->server.
" as "
.
$tic
->username;
$tic
->
connect
;
my
$tunnels
=
$tic
->tunnels;
debug
"Got some tunnels: "
.
join
' '
,
sort
keys
%{
$tunnels
};
for
my
$t
(
sort
keys
%{
$tunnels
}) {
debug
"Requesting info for tunnel $t"
;
say
$tic
->tunnel_info(
$t
)->to_text;
}
debug
"Done, it seems."
;
}
sub
usage($)
{
my
(
$err
) =
@_
;
my
$s
=
<<EOUSAGE
Usage: sixxs-tic-tunnels [-v] [-s server] -f configfile
sixxs-tic-tunnels -V | -h
-f specify the name of the authentication configuration file
-h display program usage information and exit
-s specify the address of the TIC server (default: localhost)
-V display program version information and exit
-v verbose operation; display diagnostic output
EOUSAGE
;
if
(
$err
) {
die
$s
;
}
else
{
print
"$s"
;
}
}
sub
version()
{
say
"sixxs-tic-tunnels $version"
;
}
sub
debug($)
{
say
STDERR
"RDBG $_[0]"
if
$debug
;
}
sub
read_config($ $)
{
my
(
$fname
,
$needed
) =
@_
;
open
my
$f
,
'<'
,
$fname
or
die
"Could not open $fname: $!\n"
;
my
%need
=
map
{ (
$_
, 1) } @{
$needed
};
my
%cfg
;
while
(<
$f
>) {
s/[\r\n]*$//;
next
if
/^\s*(
if
(!/^\s*(\S+)\s+(\S+)\s*$/) {
die
"Invalid configuration line: $_\n"
;
}
my
(
$k
,
$v
) = ($1, $2);
if
(
exists
$cfg
{
$k
}) {
die
"Duplicate key $k in config file $fname\n"
;
}
$cfg
{
$k
} =
$v
;
delete
$need
{
$k
};
}
close
$f
or
die
"Could not close $fname: $!\n"
;
if
(
%need
) {
die
"Missing configuration in $fname: "
.
join
(
', '
,
sort
keys
%need
).
"\n"
;
}
return
\
%cfg
;
}