8eda1ace0e
- add missing options - generate options before sub-blocks (for example in user block) - fix loadConfig not loading networks and users as arrays - add compatibility process to rename old options to their new names when loading config from bipgenconfig store
1706 lines
42 KiB
Perl
Executable File
1706 lines
42 KiB
Perl
Executable File
#!/usr/bin/env perl
|
|
#
|
|
# This file is part of the bip project
|
|
# Copyright (C) 2004 2007 Arnaud Cornet and Loïc Gomez
|
|
#
|
|
# This program is free software; you can redistribute it and/or modify
|
|
# it under the terms of the GNU General Public License as published by
|
|
# the Free Software Foundation; either version 2 of the License, or
|
|
# (at your option) any later version.
|
|
# See the file "COPYING" for the exact licensing terms.
|
|
#
|
|
|
|
use strict;
|
|
use IO::File;
|
|
use Data::Dumper;
|
|
|
|
my $bipdir = $ENV{'HOME'} . '/.bip';
|
|
my $CFILE = $bipdir . '/bip.conf.autogen';
|
|
my $sfile = $bipdir . '/bipgenconfig.store';
|
|
my $certout = $bipdir . '/bip.pem.autogen';
|
|
my $SERIALIZE_DBG = 1;
|
|
my %cf;
|
|
my $DEBUG = 0;
|
|
my $global_done = 0;
|
|
my $cert_done = 0;
|
|
my $mode = 'normal';
|
|
# maximum level of blocks { { { } } }
|
|
my $maxlevel = 5;
|
|
my $bipmkpw;
|
|
my $tmpcrt = "/tmp/bip-cert.cnf";
|
|
|
|
my %optcompat = (
|
|
"bl_msg_only" => "backlog_msg_only",
|
|
"blreset_on_talk" => "backlog_reset_on_talk",
|
|
"always_backlog" => "backlog_always",
|
|
);
|
|
|
|
my %optdesc = (
|
|
'global' => {
|
|
'ip' => { 'type' => 's', 'adv' => 1, 'default' => '0.0.0.0',
|
|
'optional' => 1,
|
|
'desc' => 'What IP address/hostname do you want bip to listen on ?' },
|
|
'port' => { 'type' => 'i', 'adv' => 1, 'default' => '7778',
|
|
'optional' => 1,
|
|
'desc' => 'What port do you want bip to listen on ?' },
|
|
'client_side_ssl' => { 'type' => 'b', 'adv' => 1, 'default' => 'true',
|
|
'optional' => 1,
|
|
'desc' => 'Do you want to enable client side SSL ?' },
|
|
'pid_file' => { 'type' => 's', 'adv' => 1, 'optional' => 1,
|
|
'default' => $bipdir . '/bip.pid',
|
|
'desc' => 'Where do you want the pidfile to be stored ?' },
|
|
'log' => { 'type' => 'b', 'adv' => 0, 'default' => 'true',
|
|
'optional' => 1,
|
|
'desc' => 'Do you want to enable channel logging ?' },
|
|
'log_system' => { 'type' => 'b', 'adv' => 0, 'default' => 'true',
|
|
'optional' => 1,
|
|
'desc' => 'Do you want to enable system logging ?' },
|
|
'log_sync_interval' => { 'type' => 'i', 'adv' => 1,
|
|
'optional' => 1,
|
|
'default' => '5', 'depends' => 'log', 'depval' => 'true',
|
|
'desc' => 'At which interval do you want bip to force logs to be written {seconds} ?' },
|
|
'log_level' => { 'type' => 'i', 'adv' => 1, 'default' => '3',
|
|
'optional' => 1,
|
|
'depends' => 'log', 'depval' => 'true',
|
|
'desc' => 'Define bip\'s system logs verbosity level {less 0 - 7 tremendous}:' },
|
|
'log_root' => { 'type' => 's', 'adv' => 0,
|
|
'optional' => 1,
|
|
'default' => $bipdir . '/logs',
|
|
'depends' => 'log', 'depval' => 'true',
|
|
'desc' => 'In which directory do you want logs to be stored ?' },
|
|
'log_format' => { 'type' => 's', 'adv' => 1, 'default' => '%n/%Y-%m/%c.%d.log',
|
|
'optional' => 1,
|
|
'depends' => 'log', 'depval' => 'true',
|
|
'desc' => 'Define the channel/private log format {see strftime, limited}:' },
|
|
},
|
|
|
|
'network' => {
|
|
'name' => { 'type' => 's', 'adv' => 0, 'default' => '',
|
|
'optional' => 0,
|
|
'desc' => 'Network\'s name' },
|
|
'ssl' => { 'type' => 'b', 'adv' => 0, 'default' => '',
|
|
'optional' => 1,
|
|
'desc' => 'Enable SSL for this network ?' },
|
|
'server' => { 'type' => 'e' },
|
|
},
|
|
|
|
'user' => {
|
|
'name' => { 'type' => 's', 'adv' => 0, 'default' => '',
|
|
'optional' => 0,
|
|
'desc' => 'User\'s internal name ?' },
|
|
'admin' => { 'type' => 'b', 'adv' => 0, 'default' => 'false',
|
|
'optional' => 1,
|
|
'desc' => 'Is user an admin ?' },
|
|
'password' => { 'type' => 'p', 'adv' => 0, 'default' => '',
|
|
'optional' => 0,
|
|
'desc' => 'Set a password for his bip account:' },
|
|
'bip_use_notice' => { 'type' => 'b', 'adv' => 0, 'default' => 'false',
|
|
'optional' => 1,
|
|
'desc' => 'Do you prefer bip to use notices instead of privmsgs ?' },
|
|
'ssl_check_mode' => { 'type' => 's', 'adv' => 1,
|
|
'optional' => 1, 'default' => 'none',
|
|
'desc' => 'Type of SSL servers certificate\'s checks' },
|
|
'ssl_check_store' => { 'type' => 's', 'adv' => 1,
|
|
'optional' => 1, 'default' => '',
|
|
'desc' => 'Path to SSL servers\'s data storage' },
|
|
'default_nick' => { 'type' => 's', 'adv' => 0, 'default' => '',
|
|
'optional' => 0,
|
|
'desc' => 'User\'s default IRC nickname' },
|
|
'default_user' => { 'type' => 's', 'adv' => 0, 'default' => '',
|
|
'optional' => 0,
|
|
'desc' => 'User\'s default IRC username' },
|
|
'default_realname' => { 'type' => 's', 'adv' => 0, 'default' => '',
|
|
'optional' => 0,
|
|
'desc' => 'User\'s default IRC realname' },
|
|
'backlog' => { 'type' => 'b', 'adv' => 0, 'default' => 'true',
|
|
'optional' => 1,
|
|
'depends' => 'log', 'depval' => 'true',
|
|
'desc' => 'Do you want to activate backlog {play back logs} system ?' },
|
|
'backlog_lines' => { 'type' => 'i', 'adv' => 0, 'default' => '10',
|
|
'optional' => 1,
|
|
'depends' => 'backlog', 'depval' => 'true',
|
|
'desc' => 'How much line do you want bip to play back upon client connect' .
|
|
" {0 => replay everything since backlog's last reset} ?" },
|
|
'backlog_no_timestamp' => { 'type' => 'b', 'adv' => 0,
|
|
'optional' => 1,
|
|
'default' => 'false', 'depends' => 'backlog', 'depval' => 'true',
|
|
'desc' => 'Disable timestamp in backlog ?' },
|
|
'backlog_msg_only' => { 'type' => 'b', 'adv' => 0,
|
|
'optional' => 1,
|
|
'default' => 'false', 'depends' => 'backlog', 'depval' => 'true',
|
|
'desc' => 'Only playback users messages {chan/priv}, no nick/join/... ?' },
|
|
'backlog_always' => { 'type' => 'b', 'adv' => 0,
|
|
'optional' => 1,
|
|
'default' => 'false', 'depends' => 'backlog', 'depval' => 'true',
|
|
'desc' => 'Always backlog {false means backlog pointers are reset after each backlog} ?' },
|
|
'backlog_reset_on_talk' => { 'type' => 'b', 'adv' => 0,
|
|
'optional' => 1,
|
|
'default' => 'false', 'depends' => 'backlog', 'depval' => 'true',
|
|
'desc' => 'Reset backlog each time an attached client "talks" ?' },
|
|
'connection' => { 'type' => 'e' },
|
|
|
|
},
|
|
|
|
'connection' => {
|
|
'name' => { 'type' => 's', 'adv' => 0, 'default' => '',
|
|
'optional' => 0,
|
|
'desc' => 'Connection name (used by bip only)' },
|
|
'network' => { 'type' => 's', 'adv' => 0, 'default' => '',
|
|
'optional' => 0, 'postdepends' => 'networks.$value',
|
|
'desc' => 'Network to connect to' },
|
|
'defid' => { 'type' => 'b', 'adv' => 0, 'default' => 'true',
|
|
'optional' => 1, 'nosave' => 1,
|
|
'desc' => 'Use default identity ?' },
|
|
'nick' => { 'type' => 's', 'adv' => 0, 'default' => '',
|
|
'optional' => 1,
|
|
'depends' => 'defid', 'depval' => 'false',
|
|
'desc' => 'IRC nickname on this connection ?' },
|
|
'user' => { 'type' => 's', 'adv' => 0, 'default' => '',
|
|
'optional' => 1,
|
|
'depends' => 'defid', 'depval' => 'false',
|
|
'desc' => 'IRC username on this connection ?' },
|
|
'realname' => { 'type' => 's', 'adv' => 0, 'default' => '',
|
|
'optional' => 1,
|
|
'depends' => 'defid', 'depval' => 'false',
|
|
'desc' => 'IRC realname on this connection ?' },
|
|
'password' => { 'type' => 's', 'adv' => 0, 'default' => '',
|
|
'optional' => 1,
|
|
'desc' => 'IRC server\'s password ?' },
|
|
'vhost' => { 'type' => 's', 'adv' => 1, 'default' => '',
|
|
'optional' => 1,
|
|
'desc' => 'Connect to IRC server from this specific IP address:' },
|
|
'source_port' => { 'type' => 'i', 'adv' => 1, 'default' => '',
|
|
'optional' => 1,
|
|
'desc' => 'Connect to IRC server from this specific port:' },
|
|
'follow_nick' => { 'type' => 'b', 'adv' => 0, 'default' => 'true',
|
|
'optional' => 1,
|
|
'desc' => 'Follow nicknames changes from clients to use upon reconnection (if false, bip\'ll use config nickname)' },
|
|
'ignore_first_nick' => { 'type' => 'b', 'adv' => 0, 'default' => 'true',
|
|
'optional' => 1,
|
|
'desc' => 'Ignore nickname change sent by a client (first one only, upon client attach)' },
|
|
'away_nick' => { 'type' => 's', 'adv' => 0, 'default' => '',
|
|
'optional' => 1,
|
|
'desc' => 'Set nickname to this value when there\'s no more client attached:' },
|
|
'no_client_away_msg' => { 'type' => 's', 'adv' => 0, 'default' => '',
|
|
'optional' => 1,
|
|
'desc' => 'Set this away message when there\'s no more client attached:' },
|
|
'on_connect_send' => { 'type' => 's', 'adv' => 0, 'default' => '',
|
|
'optional' => 1,
|
|
'desc' => 'Send this raw message upon connection to IRC server' },
|
|
'ssl_check_mode' => { 'type' => 's', 'adv' => 1,
|
|
'optional' => 1, 'default' => '',
|
|
'desc' => 'Type of SSL servers certificate\'s checks' },
|
|
'channel' => { 'type' => 'e' },
|
|
},
|
|
|
|
'channel' => {
|
|
'name' => { 'type' => 's', 'adv' => 0, 'default' => '',
|
|
'optional' => 0,
|
|
'desc' => 'Channel name' },
|
|
'key' => { 'type' => 's', 'adv' => 0, 'default' => '',
|
|
'optional' => 1,
|
|
'desc' => 'Channel key (optional)' },
|
|
},
|
|
|
|
'server' => {
|
|
'host' => { 'type' => 's', 'adv' => 0, 'default' => '',
|
|
'optional' => 0,
|
|
'desc' => 'IRC server\'s IP address/hostname' },
|
|
'port' => { 'type' => 'i', 'adv' => 0, 'default' => '6667',
|
|
'optional' => 0,
|
|
'desc' => 'IRC server\'s port' },
|
|
}
|
|
);
|
|
my %optorder = (
|
|
'global' => [
|
|
'ip' ,
|
|
'port' ,
|
|
'client_side_ssl' ,
|
|
'pid_file' ,
|
|
undef,
|
|
'log' ,
|
|
'log_system' ,
|
|
'log_sync_interval' ,
|
|
'log_level' ,
|
|
'log_root' ,
|
|
'log_format' ,
|
|
],
|
|
|
|
'network' => [
|
|
'name' ,
|
|
'ssl' ,
|
|
'server' ,
|
|
],
|
|
|
|
'user' => [
|
|
'name' ,
|
|
'password' ,
|
|
'ssl_check_mode' ,
|
|
'ssl_check_store' ,
|
|
undef,
|
|
'default_nick' ,
|
|
'default_user' ,
|
|
'default_realname' ,
|
|
undef,
|
|
'backlog' ,
|
|
'backlog_lines' ,
|
|
'backlog_no_timestamp' ,
|
|
'backlog_msg_only' ,
|
|
'backlog_always' ,
|
|
'backlog_reset_on_talk' ,
|
|
'connection' ,
|
|
],
|
|
|
|
'connection' => [
|
|
'name' ,
|
|
'network' ,
|
|
'defid',
|
|
'nick' ,
|
|
'user' ,
|
|
'realname' ,
|
|
'password' ,
|
|
undef,
|
|
'vhost' ,
|
|
'source_port' ,
|
|
'follow_nick' ,
|
|
'ignore_first_nick' ,
|
|
'away_nick' ,
|
|
'no_client_away_msg' ,
|
|
'on_connect_send' ,
|
|
'ssl_check_mode' ,
|
|
'channel' ,
|
|
],
|
|
|
|
'channel' => [
|
|
'name' ,
|
|
'key' ,
|
|
],
|
|
|
|
'server' => [
|
|
'host' ,
|
|
'port' ,
|
|
]
|
|
);
|
|
|
|
my $clear_string = `clear`;
|
|
|
|
sub myexit {
|
|
warn("Error: $1");
|
|
warn("Saving configuration...");
|
|
save_config();
|
|
warn("Don't worry, your configuration has been saved ;)");
|
|
exit(1);
|
|
}
|
|
|
|
sub askOpt {
|
|
my ($e, $curval, $mayempty) = @_;
|
|
my ($o, $sel);
|
|
|
|
$sel = (($curval ne undef) ? $curval : $e->{'default'});
|
|
return $sel if ($mode eq 'normal' && $e->{'adv'} eq 1);
|
|
|
|
while (1) {
|
|
my $opt = (defined $e->{'optional'} && $e->{'optional'} eq 1 ?
|
|
1 : 0);
|
|
if ($e->{'type'} eq 'b') {
|
|
$o = askbool($e->{'desc'}, $sel, 1);
|
|
} elsif ($e->{'type'} eq 'p') {
|
|
$o = askPass($e->{'desc'});
|
|
} else {
|
|
$o = askval($e->{'desc'}, $sel, ($mayempty && ($opt ne 1 ||
|
|
$e->{'type'} eq 'i' ? 1 : undef)), 1);
|
|
}
|
|
if ($o eq undef && $opt eq 0) {
|
|
print("This value is mandatory, please enter a value\n");
|
|
next;
|
|
}
|
|
if ($e->{'type'} eq 'i' && $o !~ /^\d*$/) {
|
|
print("We want a number here, please enter one\n");
|
|
next;
|
|
}
|
|
last;
|
|
}
|
|
return $o;
|
|
}
|
|
|
|
sub align {
|
|
my ($text, $num) = @_;
|
|
my ($out, $pos, $orig);
|
|
|
|
$orig = $text;
|
|
while ($text ne '' || $text ne undef) {
|
|
$num = 60 if (!$num);
|
|
$pos = rindex($text, " ", 60);
|
|
$out .= "\n" if ($out);
|
|
$out .= substr($text, 0, $pos);
|
|
$text = substr($text, $pos+1);
|
|
}
|
|
$out .= " ";
|
|
|
|
return $out;
|
|
}
|
|
|
|
sub askbool {
|
|
my ($text, $default, $star) = @_;
|
|
|
|
$text = "* $text" if $star;
|
|
if ($default eq "true") {
|
|
print align("$text [Y/n] ");
|
|
} else {
|
|
$default = "false";
|
|
print align("$text [y/N] ");
|
|
}
|
|
|
|
|
|
while (my $l = <STDIN>) {
|
|
chomp($l);
|
|
if ($default eq "true" && $l =~ /^n$/i) {
|
|
return "false";
|
|
} elsif ($default eq "false" && $l =~ /^y$/i) {
|
|
return "true";
|
|
} elsif (!$default && $l eq '') {
|
|
return undef;
|
|
} else {
|
|
return $default;
|
|
}
|
|
}
|
|
}
|
|
|
|
sub askPass {
|
|
my ($text) = @_;
|
|
|
|
while (!$bipmkpw || ! -x "$bipmkpw") {
|
|
if ($bipmkpw ne '' && (! -f $bipmkpw || ! -x $bipmkpw)) {
|
|
print("No exec permission: $bipmkpw\n");
|
|
}
|
|
$bipmkpw = askval("Please enter the path to bipmkpw:",
|
|
undef, 1);
|
|
}
|
|
print("$text ? ");
|
|
my $pass = `$bipmkpw`;
|
|
chomp($pass);
|
|
$pass =~ s/^Password:\s*\n?//si;
|
|
chomp($pass);
|
|
return $pass;
|
|
}
|
|
|
|
sub askval {
|
|
my ($text, $default, $skipblank, $star) = @_;
|
|
|
|
$text .= " ";
|
|
$text .= "[$default] " if ($default ne undef);
|
|
$text = "* $text" if $star;
|
|
print(align("$text"));
|
|
while (my $l = <STDIN>) {
|
|
chomp($l);
|
|
# if ($default eq undef && !$skipblank && $l eq '') {
|
|
# my $q = askbool("You've entered a blank value, do you want this field to be unset (if not, it'll be set to the empty string) ?", "true");
|
|
# return undef if ($q eq 'true');
|
|
# }
|
|
return ($l ne '' ? $l : $default);
|
|
}
|
|
}
|
|
|
|
sub checkDepends {
|
|
my ($n, $v) = @_;
|
|
return if (!exists($v->{'depends'}));
|
|
|
|
my $d = $v->{'depends'};
|
|
if (!exists($cf{'global'}->{$d})) {
|
|
return "You cannot define `$n' since `$d' isn't defined";
|
|
}
|
|
if (exists($v->{'depval'}) &&
|
|
$cf{'global'}->{$d} ne $v->{'depval'}) {
|
|
return "You cannot define `$n' since `$d' isn't set to " .
|
|
$v->{'depval'};
|
|
}
|
|
}
|
|
|
|
sub loadConfig {
|
|
my ($f) = @_;
|
|
my ($fh, $data, $hr);
|
|
|
|
$fh = new IO::File;
|
|
$data = '';
|
|
$fh->open($f) || return "Unable to open $f";
|
|
while (<$fh>) {
|
|
chomp();
|
|
$data .= $_;
|
|
}
|
|
$fh->close;
|
|
$hr = unserialize($data) || return "Invalid format in $f";
|
|
%cf = %{$hr};
|
|
$cf{'networks'} = [ values %{$cf{'networks'}} ];
|
|
$cf{'users'} = [ values %{$cf{'users'}} ];
|
|
|
|
sanitizeCompat(\%cf);
|
|
foreach (@{$cf{'networks'}}) {
|
|
$_->{'server'} = [ values %{$_->{'server'}} ];
|
|
}
|
|
foreach my $tcu (@{$cf{'users'}}) {
|
|
$tcu->{'connection'} = [ values %{$tcu->{'connection'}} ];
|
|
foreach my $tcc (@{$tcu->{'connection'}}) {
|
|
$tcc->{'channel'} = [ values %{$tcc->{'channel'}} ];
|
|
}
|
|
}
|
|
return "Config loaded from $f";
|
|
}
|
|
|
|
sub sanitizeCompat {
|
|
my ($d) = @_;
|
|
|
|
foreach (keys %$d) {
|
|
if (ref($d->{$_}) eq 'ARRAY') {
|
|
foreach my $d2 (@{$d->{$_}}) {
|
|
sanitizeCompat($d2);
|
|
}
|
|
}
|
|
$d->{$optcompat{$_}} = $d->{$_} if (defined $optcompat{$_});
|
|
}
|
|
}
|
|
|
|
sub resetConfig {
|
|
my $r = askbool("Do you want to reset current loaded configuration options, networks, users... ?", 'false');
|
|
$r eq 'false' && return "Reset config aborted";
|
|
|
|
%cf = ();
|
|
-e "$sfile" || return "Configuration cleared";
|
|
my $r = askbool("Do you want to delete saved configuration file $sfile too ?", 'false');
|
|
if ($r eq 'true') {
|
|
unlink($sfile) || return "Unable to remove file $sfile, current config has been cleared";
|
|
return "Configuration cleared, saved-configuration file removed";
|
|
}
|
|
return "Configuration cleared";
|
|
}
|
|
|
|
sub setOptions {
|
|
foreach my $n (@{$optorder{'global'}}) {
|
|
if ($n eq undef) {
|
|
print("\n");
|
|
next;
|
|
}
|
|
my $e = $optdesc{'global'}->{$n};
|
|
my $r = checkDepends($n, $e);
|
|
if ($r) {
|
|
print("$r\n") if ($DEBUG);
|
|
$cf{'global'}->{$n} = undef;
|
|
next;
|
|
}
|
|
$cf{'global'}->{$n} = askOpt($e, $cf{'global'}->{$n});
|
|
}
|
|
$global_done = 1;
|
|
pause();
|
|
return "Options have been set";
|
|
}
|
|
|
|
sub printOptions {
|
|
my $cnt = 1;
|
|
foreach my $n (@{$optorder{'global'}}) {
|
|
next if (!$n);
|
|
my $e = $optdesc{'global'}->{$n};
|
|
next if ($e->{'type'} eq 'e' || $e->{'nosave'} eq 1);
|
|
next if ($mode eq 'normal' && $e->{'adv'} eq 1);
|
|
|
|
my $r = checkDepends($n, $e);
|
|
if ($r) {
|
|
printf('%02d.(%s - unset, missing dependency)'."\n", $cnt, $n);
|
|
} elsif (exists($cf{'global'}->{$n})) {
|
|
printf('%02d. %s = %s'."\n", $cnt, $n, $cf{'global'}->{$n});
|
|
} else {
|
|
printf('%02d. %s - unset'."\n", $cnt, $n);
|
|
}
|
|
$cnt++;
|
|
}
|
|
pause();
|
|
return;
|
|
}
|
|
|
|
sub makeCert {
|
|
my ($fh, $c, $o, $ou, $cn);
|
|
$fh = new IO::File;
|
|
$c = askval("SSL cert country :", undef, 1);
|
|
$o = askval("SSL cert organisation :", "Sexy boys");
|
|
$ou = askval("SSL cert organisational unit :", "Bip");
|
|
$cn = askval("SSL cert common name :", "Bip");
|
|
|
|
$fh->open("> $tmpcrt");
|
|
return "Unable to write to $tmpcrt\n" if (!$fh);
|
|
print $fh "HOME = .
|
|
|
|
[ req ]
|
|
distinguished_name = dn
|
|
x509_extensions = v3_bip
|
|
default_md = sha1
|
|
prompt = no
|
|
|
|
[ dn ]
|
|
C=$c
|
|
O=$o
|
|
OU=$ou
|
|
CN=$cn
|
|
|
|
[ v3_bip ]
|
|
subjectKeyIdentifier=hash
|
|
authorityKeyIdentifier=keyid:always";
|
|
|
|
# if (-e $certout) {
|
|
# my @t = localtime(time);
|
|
# my $ts = sprintf("%04d-%02d-%02d.%02d:%02d:%02d", 1900+$t[5], 1+$t[4], $t[3], $t[2], $t[1], $t[0]);
|
|
# rename($certout, "$certout.$ts");
|
|
# print "Existing $certout found, renamed to $certout.$ts\n";
|
|
# }
|
|
|
|
`openssl req -new -x509 -days 365 -nodes -config "$tmpcrt" -out "$certout" -keyout "$certout"`;
|
|
# TODO check command status
|
|
`openssl x509 -subject -dates -fingerprint -noout -in "$certout"`;
|
|
# TODO check command status
|
|
$cert_done = 1;
|
|
print "Certificate/key pair has been generated in $certout\n";
|
|
unlink("$tmpcrt");
|
|
pause();
|
|
return "Certificate/key pair has been generated in $certout";
|
|
}
|
|
|
|
sub writeConfig {
|
|
my ($f) = @_;
|
|
my ($fh, $ts, @t);
|
|
|
|
$ts = localtime(time);
|
|
$fh = new IO::File;
|
|
if (!$fh->open('> ' . $f)) {
|
|
print("Unable to open $f for writing\n");
|
|
return;
|
|
}
|
|
print $fh "# vim:ft=bip:ts=2\n";
|
|
print $fh "# Auto-generated BIP IRC Proxy configuration $ts \n";
|
|
print $fh "#\n";
|
|
print $fh "### Global options\n";
|
|
foreach my $k (keys(%{$cf{'global'}})) {
|
|
next if ($cf{'global'}->{$k} eq undef);
|
|
next if ($optdesc{'global'}->{$k}->{'nosave'} eq 1);
|
|
my $t = $optdesc{'global'}->{$k}->{'type'};
|
|
if ($t eq 's') {
|
|
print $fh "$k = \"" . $cf{'global'}->{$k} . "\";\n";
|
|
} else {
|
|
print $fh "$k = " . $cf{'global'}->{$k} . ";\n";
|
|
}
|
|
}
|
|
print $fh "\n";
|
|
print $fh "### Networks\n";
|
|
foreach my $e (@{$cf{'networks'}}) {
|
|
my $out = printBlock("", 'network', $e, 1);
|
|
print $fh $out;
|
|
}
|
|
print $fh "\n";
|
|
print $fh "### Users\n";
|
|
foreach my $e (@{$cf{'users'}}) {
|
|
my $out = printBlock("", 'user', $e, 1);
|
|
print $fh $out;
|
|
}
|
|
print $fh "\n";
|
|
$fh->close;
|
|
print("Configuration saved in $f\n");
|
|
my $u = (exists($cf{'users'}) ? scalar @{$cf{'users'}}
|
|
: 0);
|
|
my $n = (exists($cf{'networks'}) ? scalar @{$cf{'networks'}}
|
|
: 0);
|
|
print "You haven't set global options\n" if (!$global_done);
|
|
print "$u users defined, $n networks defined\n";
|
|
print "The certificate/key pair is in $certout\n"
|
|
if ($cert_done eq 1);
|
|
print "Configuration has been generated in $CFILE\n";
|
|
print "You have to rename all generated files to use them\n";
|
|
return;
|
|
}
|
|
|
|
sub storeConfig {
|
|
my ($f) = @_;
|
|
my ($fh);
|
|
|
|
$fh = new IO::File;
|
|
$fh->open('> ' . $f) || return "Unable to open $f for writing";
|
|
print $fh serialize(\%cf);
|
|
$fh->close;
|
|
return "Configuration stored in $f";
|
|
}
|
|
|
|
sub printBlock {
|
|
my ($prefix, $name, $e, $level) = @_;
|
|
my $out = '';
|
|
|
|
fatal("Too much recursion levels ($level)") if ($level ge $maxlevel);
|
|
|
|
$out .= $prefix . $name . " {\n";
|
|
foreach my $k (@{$optorder{$name}}) {
|
|
next if ($k eq undef);
|
|
next if ($e->{$k} eq undef);
|
|
next if ($optdesc{$name}->{$k}->{'nosave'} eq 1);
|
|
my $t = $optdesc{$name}->{$k}->{'type'};
|
|
if ($t eq 's' || $t eq 'p') {
|
|
$out .= $prefix . "\t$k = \"" . $e->{$k} . "\";\n";
|
|
} elsif (ref($e->{$k}) eq 'ARRAY') {
|
|
foreach my $e2 (@{$e->{$k}}) {
|
|
$out .= printBlock($prefix . "\t", $k, $e2, $level+1);
|
|
}
|
|
} else {
|
|
$out .= $prefix . "\t$k = " . $e->{$k} . ";\n";
|
|
}
|
|
}
|
|
$out .= $prefix . "};\n\n";
|
|
return $out;
|
|
}
|
|
|
|
sub addEntry {
|
|
my ($section, $nopause) = @_;
|
|
my ($e, $opts);
|
|
|
|
$opts = $optdesc{$section};
|
|
|
|
foreach my $n (@{$optorder{$section}}) {
|
|
if ($n eq undef) {
|
|
print("\n");
|
|
next;
|
|
}
|
|
|
|
my $v = $optdesc{$section}->{$n};
|
|
my $r = checkDepends($n, $v);
|
|
if ($r) {
|
|
$e->{$n} = undef;
|
|
print("$r\n") if ($DEBUG);
|
|
next;
|
|
}
|
|
if ($v->{'type'} eq 'e') {
|
|
my $first = 1;
|
|
do {
|
|
if ($v->{'optional'} eq 1 || !$first) {
|
|
my $a = askbool("Do you want to add a new $n ?", 'true');
|
|
last if ($a eq 'false');
|
|
}
|
|
print("\nAdding a new $n :\n");
|
|
my $e2 = addEntry($n, 1);
|
|
if (ref($e->{$n}) eq 'ARRAY') {
|
|
push(@{$e->{$n}}, $e2);
|
|
} else {
|
|
$e->{$n} = [ $e2 ];
|
|
}
|
|
$first = 0;
|
|
} while (1);
|
|
} else {
|
|
$e->{$n} = askOpt($v);
|
|
}
|
|
}
|
|
pause() if (!$nopause);
|
|
return $e;
|
|
}
|
|
|
|
sub pause {
|
|
my ($txt) = @_;
|
|
|
|
$txt = "Press any key to continue" if (!$txt);
|
|
print("\n" . $txt . "\n");
|
|
<STDIN>;
|
|
}
|
|
|
|
sub printMenu {
|
|
my ($mhead, $mopts, $mfoot, $mask) = @_;
|
|
|
|
push(@{$mhead}, undef);
|
|
if ($mode eq 'normal') {
|
|
push(@{$mhead},
|
|
"WARNING: non-advanced mode, some 'expert' " .
|
|
"options'll be hidden !");
|
|
} else {
|
|
push(@{$mhead}, undef);
|
|
}
|
|
push(@{$mhead}, undef);
|
|
print($clear_string);
|
|
print("###########################################################" .
|
|
"###################\n# ");
|
|
print(join("\n# ", @{$mhead}));
|
|
print("\n");
|
|
print("\n");
|
|
foreach my $n (sort {$a <=> $b} keys(%{$mopts})) {
|
|
if ($mopts->{$n} eq undef) {
|
|
print("\n");
|
|
next;
|
|
}
|
|
printf(' %2d. %s%s', $n, $mopts->{$n}, "\n");
|
|
}
|
|
print("\n");
|
|
print(join("\n", @{$mfoot}));
|
|
print("\n");
|
|
print("\n");
|
|
return askval($mask, undef, 1);
|
|
}
|
|
|
|
sub printUsers {
|
|
my ($txt) = @_;
|
|
my ($mopts, $mhead, $mfoot, $mask, $num, $warn, $act, $out);
|
|
|
|
$mhead = [
|
|
"Bip's user list",
|
|
];
|
|
$mfoot = [ $txt ];
|
|
$mask = "Enter id of the user to edit ?";
|
|
$mopts = { 0 => 'Return to main menu'};
|
|
$mopts->{"0.5"} = undef;
|
|
$num = 1;
|
|
foreach my $n (@{$cf{'users'}}) {
|
|
$mopts->{$num} = $n->{'name'} . ': ' .
|
|
(scalar @{$n->{'connection'}}) . ' connections.';
|
|
$num++;
|
|
}
|
|
|
|
$act = printMenu($mhead, $mopts, $mfoot, $mask);
|
|
print($clear_string);
|
|
if ($act eq 0) {
|
|
return;
|
|
} elsif ($act =~ /^\d+$/) {
|
|
my $n = $cf{'users'};
|
|
my $c = $num-1;
|
|
if (($num-$act) le 0) {
|
|
$out = "There are only $c users";
|
|
} else {
|
|
$out = printEditUser($act-1);
|
|
}
|
|
} else {
|
|
$out = "Invalid user ID";
|
|
}
|
|
printUsers($out);
|
|
}
|
|
|
|
sub printNetworks {
|
|
my ($txt) = @_;
|
|
my ($mopts, $mhead, $mfoot, $mask, $num, $warn, $act, $out);
|
|
|
|
$mhead = [
|
|
"Bip's network list",
|
|
];
|
|
$mfoot = [ $txt ];
|
|
$mask = "Enter ID of the network to edit ?";
|
|
$mopts = { 0 => 'Return to main menu'};
|
|
$mopts->{"0.5"} = undef;
|
|
$num = 1;
|
|
foreach my $n (@{$cf{'networks'}}) {
|
|
$mopts->{$num} = $n->{'name'} . ': ' . (scalar @{$n->{'server'}})
|
|
. ' servers, SSL ' . ($n->{'ssl'} eq 'true' ?
|
|
'enabled' : 'disabled');
|
|
$num++;
|
|
}
|
|
|
|
$act = printMenu($mhead, $mopts, $mfoot, $mask);
|
|
print($clear_string);
|
|
if ($act eq 0) {
|
|
return;
|
|
} elsif ($act =~ /^\d+$/) {
|
|
my $n = $cf{'networks'};
|
|
my $c = $num-1;
|
|
if (($num-$act) le 0) {
|
|
$out = "There are only $c networks";
|
|
} else {
|
|
$out = printEditNetwork($act-1);
|
|
}
|
|
} else {
|
|
$out = "Invalid network ID";
|
|
}
|
|
printNetworks($out);
|
|
}
|
|
|
|
sub addChannel {
|
|
my ($uid, $cid) = @_;
|
|
my ($cnt, @o, $n, $c, $name);
|
|
|
|
return "Invalid user ID $uid"
|
|
if ((scalar @{$cf{'users'}}) le $uid);
|
|
$n = $cf{'users'}[$uid];
|
|
return "Invalid connection ID $cid"
|
|
if ((scalar @{$n->{'connection'}}) le $cid);
|
|
my $e = addEntry('channel');
|
|
if ($e) {
|
|
push(@{$n->{'connection'}[$cid]->{'channel'}}, $e);
|
|
return "Channel " . $e->{'name'} . " added";
|
|
} else {
|
|
return "Channel add failed";
|
|
}
|
|
|
|
}
|
|
|
|
sub addServer {
|
|
my ($id) = @_;
|
|
|
|
return "Invalid network ID $id"
|
|
if ((scalar @{$cf{'networks'}}) le $id);
|
|
my $e = addEntry('server');
|
|
if ($e) {
|
|
push(@{$cf{'networks'}[$id]->{'server'}}, $e);
|
|
return "Server " . $e->{'host'} . " added";
|
|
} else {
|
|
return "Server add failed";
|
|
}
|
|
}
|
|
|
|
sub addConnection {
|
|
my ($id) = @_;
|
|
|
|
return "Invalid user ID $id"
|
|
if ((scalar @{$cf{'users'}}) le $id);
|
|
my $e = addEntry('connection');
|
|
if ($e) {
|
|
push(@{$cf{'users'}[$id]->{'connection'}}, $e);
|
|
return "Connection " . $e->{'name'} . " added";
|
|
} else {
|
|
return "Connection add failed";
|
|
}
|
|
}
|
|
|
|
|
|
sub deleteServer {
|
|
my ($net, $sid) = @_;
|
|
my ($sname, $ss, $cnt, @o);
|
|
|
|
return "Invalid network ID $net"
|
|
if ((scalar @{$cf{'networks'}}) le $net);
|
|
$ss = $cf{'networks'}[$net]->{'server'};
|
|
return "Invalid server ID $sid" if ((scalar @{$ss}) lt $sid);
|
|
@o = ();
|
|
$cnt = 0;
|
|
foreach my $s (@{$ss}) {
|
|
if ($sid ne $cnt) {
|
|
push(@o, $s);
|
|
} else {
|
|
$sname = $s->{'host'};
|
|
}
|
|
$cnt++;
|
|
}
|
|
$cf{'networks'}[$net]->{'server'} = [ @o ];
|
|
return "Server $sname removed";
|
|
}
|
|
|
|
sub delUser {
|
|
my ($id) = @_;
|
|
my ($cnt, @o, $name);
|
|
|
|
return "Invalid user ID $id"
|
|
if ((scalar @{$cf{'users'}}) le $id);
|
|
$cnt = 0;
|
|
@o = ();
|
|
foreach my $n (@{$cf{'users'}}) {
|
|
if ($id ne $cnt) {
|
|
push(@o, $n);
|
|
} else {
|
|
$name = $n->{'name'};
|
|
}
|
|
$cnt++;
|
|
}
|
|
$cf{'users'} = [ @o ];
|
|
return "User $name removed";
|
|
}
|
|
|
|
sub delNetwork {
|
|
my ($id) = @_;
|
|
my ($cnt, @o, $name);
|
|
|
|
return "Invalid network ID $id"
|
|
if ((scalar @{$cf{'networks'}}) le $id);
|
|
$cnt = 0;
|
|
@o = ();
|
|
foreach my $n (@{$cf{'networks'}}) {
|
|
if ($id ne $cnt) {
|
|
push(@o, $n);
|
|
} else {
|
|
$name = $n->{'name'};
|
|
}
|
|
$cnt++;
|
|
}
|
|
$cf{'networks'} = [ @o ];
|
|
return "Network $name removed";
|
|
}
|
|
|
|
sub deleteConn {
|
|
my ($uid, $cid) = @_;
|
|
my ($cnt, @o, $n, $name);
|
|
|
|
return "Invalid user ID $uid"
|
|
if ((scalar @{$cf{'users'}}) le $uid);
|
|
$n = $cf{'users'}[$uid];
|
|
return "Invalid connection ID $cid"
|
|
if ((scalar @{$n->{'connection'}}) le $cid);
|
|
|
|
$cnt = 0;
|
|
@o = ();
|
|
foreach my $n (@{$n->{'connection'}}) {
|
|
if ($cid ne $cnt) {
|
|
push(@o, $n);
|
|
} else {
|
|
$name = $n->{'name'};
|
|
}
|
|
$cnt++;
|
|
}
|
|
$cf{'users'}[$uid]->{'connection'} = [ @o ];
|
|
return "Connection $name removed";
|
|
}
|
|
|
|
sub deleteChannel {
|
|
my ($uid, $cid, $chid) = @_;
|
|
my ($cnt, @o, $n, $c, $name);
|
|
|
|
return "Invalid user ID $uid"
|
|
if ((scalar @{$cf{'users'}}) le $uid);
|
|
$n = $cf{'users'}[$uid];
|
|
return "Invalid connection ID $cid"
|
|
if ((scalar @{$n->{'connection'}}) le $cid);
|
|
$c = $n->{'connection'}[$cid];
|
|
return "Invalid channel ID $chid"
|
|
if ((scalar @{$c->{'channel'}}) le $chid);
|
|
|
|
$cnt = 0;
|
|
@o = ();
|
|
foreach my $n (@{$c->{'channel'}}) {
|
|
if ($chid ne $cnt) {
|
|
push(@o, $n);
|
|
} else {
|
|
$name = $n->{'name'};
|
|
}
|
|
$cnt++;
|
|
}
|
|
$cf{'users'}[$uid]->{'connection'}[$cid]->{'channel'} = [ @o ];
|
|
return "Channel $name removed";
|
|
}
|
|
|
|
|
|
sub printEditConnOptions {
|
|
my ($num, $num2, $txt) = @_;
|
|
my ($mopts, $mhead, $mfoot, $mask, $warn, $act, $out);
|
|
my ($n, $c, $name, $sub, $cnt);
|
|
|
|
return "Invalid user ID $num"
|
|
if ((scalar @{$cf{'users'}}) le $num);
|
|
$n = $cf{'users'}[$num];
|
|
return "Invalid connection ID $num2"
|
|
if ((scalar @{$n->{'connection'}}) le $num2);
|
|
$c = $n->{'connection'}[$num2];
|
|
$name = $c->{'name'};
|
|
$mhead = [
|
|
"Edit connection options $name/" . $n->{'name'},
|
|
];
|
|
$mfoot = [ $txt ];
|
|
$mopts = { 0 => 'Return to connection ' . $name,
|
|
"0.5" => undef,
|
|
};
|
|
$cnt = 1;
|
|
my %oo = ();
|
|
foreach my $s (@{$optorder{'connection'}}) {
|
|
next if (!$s);
|
|
next if ($optdesc{'connection'}->{$s}->{'type'} eq 'e');
|
|
next if ($optdesc{'connection'}->{$s}->{'nosave'} eq 1);
|
|
next if ($mode eq 'normal' &&
|
|
$optdesc{'connection'}->{$s}->{'adv'} eq 1);
|
|
$mopts->{$cnt} = "Change $s: ";
|
|
$mopts->{$cnt} .= $c->{$s} if (defined $c->{$s});
|
|
$oo{$cnt} = $s;
|
|
$cnt++;
|
|
}
|
|
|
|
$act = int(printMenu($mhead, $mopts, $mfoot, $mask));
|
|
print($clear_string);
|
|
if ($act eq 0) {
|
|
return;
|
|
} elsif ($act =~ /^\d+$/) {
|
|
my $c = $cnt-1;
|
|
if (($cnt-$act) le 0) {
|
|
$out = "There are only $c options";
|
|
} else {
|
|
my $on = $oo{$act};
|
|
$cf{'users'}[$num]->{'connection'}[$num2]->{$on} =
|
|
askOpt($optdesc{'connection'}->{$on},
|
|
$cf{'users'}[$num]->{'connection'}[$num2]->{$on});
|
|
$out = "Option $on set";
|
|
pause();
|
|
}
|
|
} else {
|
|
$out = "Invalid option ID";
|
|
}
|
|
printEditConnOptions($num, $num2, $out);
|
|
}
|
|
|
|
sub printEditConnection {
|
|
my ($num, $num2, $txt) = @_;
|
|
my ($mopts, $mhead, $mfoot, $mask, $warn, $act, $out);
|
|
my ($n, $name, $sub, $cnt, $c);
|
|
|
|
return "Invalid user ID $num"
|
|
if ((scalar @{$cf{'users'}}) le $num);
|
|
$n = $cf{'users'}[$num];
|
|
return "Invalid connection ID $num2"
|
|
if ((scalar @{$n->{'connection'}}) le $num2);
|
|
$c = $n->{'connection'}[$num2];
|
|
$name = $c->{'name'};
|
|
$sub = $c->{'channel'};
|
|
$mhead = [
|
|
"Edit connection $name/" . $n->{'name'},
|
|
];
|
|
$mfoot = [ $txt ];
|
|
$mask = "What do you want to do ?";
|
|
$mopts = { 0 => 'Return to user ' . $n->{'name'},
|
|
1 => 'Add a channel',
|
|
2 => 'Edit options',
|
|
3 => 'Remove this connection',
|
|
"3.5" => undef,
|
|
};
|
|
$cnt = 4;
|
|
foreach my $s (@{$sub}) {
|
|
$mopts->{$cnt} = "Delete channel " . $s->{'name'};
|
|
$mopts->{$cnt} .= '/' . $s->{'key'} if (defined $s->{'key'} &&
|
|
$s->{'key'} ne '');
|
|
$cnt++;
|
|
}
|
|
|
|
$act = printMenu($mhead, $mopts, $mfoot, $mask);
|
|
print($clear_string);
|
|
if ($act eq 0) {
|
|
return;
|
|
} elsif ($act eq 1) {
|
|
$out = addChannel($num, $num2);
|
|
} elsif ($act eq 2) {
|
|
return printEditConnOptions($num, $num2);
|
|
} elsif ($act eq 3) {
|
|
return deleteConn($num, $num2);
|
|
} elsif ($act =~ /^\d+$/) {
|
|
my $c = $cnt-4;
|
|
if (($cnt-$act) le 0) {
|
|
$out = "This connection has only $c channels";
|
|
} else {
|
|
$out = deleteChannel($num, $num2, $act-4);
|
|
}
|
|
} else {
|
|
$out = "Invalid channel ID";
|
|
}
|
|
printEditConnection($num, $num2, $out);
|
|
|
|
}
|
|
|
|
sub printEditUserOptions {
|
|
my ($num, $txt) = @_;
|
|
my ($mopts, $mhead, $mfoot, $mask, $warn, $act, $out);
|
|
my ($n, $name, $sub, $cnt);
|
|
|
|
return "Invalid user ID $num"
|
|
if ((scalar @{$cf{'users'}}) le $num);
|
|
$n = $cf{'users'}[$num];
|
|
$name = $n->{'name'};
|
|
$mhead = [
|
|
"Edit user $name options",
|
|
];
|
|
$mfoot = [ $txt ];
|
|
$mask = "What do you want to do ?";
|
|
$mopts = { 0 => 'Return to user ' . $name,
|
|
"0.5" => undef,
|
|
};
|
|
$cnt = 1;
|
|
my %oo = ();
|
|
foreach my $s (@{$optorder{'user'}}) {
|
|
next if (!$s);
|
|
next if ($optdesc{'user'}->{$s}->{'type'} eq 'e');
|
|
next if ($optdesc{'user'}->{$s}->{'nosave'} eq 1);
|
|
next if ($mode eq 'normal' &&
|
|
$optdesc{'user'}->{$s}->{'adv'} eq 1);
|
|
$mopts->{$cnt} = "Change $s: ";
|
|
$mopts->{$cnt} .= $n->{$s} if (defined $n->{$s});
|
|
$oo{$cnt} = $s;
|
|
$cnt++;
|
|
}
|
|
|
|
$act = printMenu($mhead, $mopts, $mfoot, $mask);
|
|
print($clear_string);
|
|
if ($act eq 0) {
|
|
return;
|
|
} elsif ($act =~ /^\d+$/) {
|
|
my $c = $cnt-1;
|
|
if (($cnt-$act) le 0) {
|
|
$out = "There are only $c options";
|
|
} else {
|
|
my $on = $oo{$act};
|
|
$cf{'users'}[$num]->{$on} = askOpt(
|
|
$optdesc{'user'}->{$on},
|
|
$cf{'users'}[$num]->{$on});
|
|
$out = "Option $on set";
|
|
pause();
|
|
}
|
|
} else {
|
|
$out = "Invalid option ID";
|
|
}
|
|
printEditUserOptions($num, $out);
|
|
|
|
|
|
}
|
|
|
|
sub printEditUser {
|
|
my ($num, $txt) = @_;
|
|
my ($mopts, $mhead, $mfoot, $mask, $warn, $act, $out);
|
|
my ($n, $name, $sub, $cnt);
|
|
|
|
return "Invalid user ID $num"
|
|
if ((scalar @{$cf{'users'}}) le $num);
|
|
$n = $cf{'users'}[$num];
|
|
$name = $n->{'name'};
|
|
$sub = $n->{'connection'};
|
|
$mhead = [
|
|
"Edit user $name",
|
|
];
|
|
$mfoot = [ $txt ];
|
|
$mask = "What do you want to do ?";
|
|
$mopts = { 0 => 'Return to users list',
|
|
1 => 'Add a connection',
|
|
2 => 'Edit options',
|
|
3 => 'Remove this user',
|
|
"3.5" => undef,
|
|
};
|
|
$cnt = 4;
|
|
foreach my $s (@{$sub}) {
|
|
$mopts->{$cnt} = "Edit connection " . $s->{'name'};
|
|
$cnt++;
|
|
}
|
|
|
|
$act = printMenu($mhead, $mopts, $mfoot, $mask);
|
|
print($clear_string);
|
|
if ($act eq 0) {
|
|
return;
|
|
} elsif ($act eq 1) {
|
|
$out = addConnection($num);
|
|
} elsif ($act eq 2) {
|
|
return printEditUserOptions($num);
|
|
} elsif ($act eq 3) {
|
|
return delUser($num);
|
|
} elsif ($act =~ /^\d+$/) {
|
|
my $c = $cnt-4;
|
|
if (($cnt-$act) le 0) {
|
|
$out = "This user has only $c connections";
|
|
} else {
|
|
$out = printEditConnection($num, $act-4)
|
|
}
|
|
} else {
|
|
$out = "Invalid connection ID";
|
|
}
|
|
printEditUser($num, $out);
|
|
|
|
}
|
|
|
|
sub printEditNetwork {
|
|
my ($num, $txt) = @_;
|
|
my ($mopts, $mhead, $mfoot, $mask, $warn, $act, $out);
|
|
my ($n, $name, $sub, $cnt);
|
|
|
|
return "Invalid network ID $num"
|
|
if ((scalar @{$cf{'networks'}}) le $num);
|
|
$n = $cf{'networks'}[$num];
|
|
$name = $n->{'name'};
|
|
$sub = $n->{'server'};
|
|
$mhead = [
|
|
"Edit network $name",
|
|
];
|
|
$mfoot = [ $txt ];
|
|
$mask = "What do you want to do ?";
|
|
$mopts = { 0 => 'Return to networks list',
|
|
1 => 'Add a server',
|
|
2 => 'Remove this network',
|
|
"2.5" => undef,
|
|
};
|
|
$cnt = 3;
|
|
foreach my $s (@{$sub}) {
|
|
$mopts->{$cnt} = "Delete server: " . $s->{'host'} . '/' .
|
|
$s->{'port'};
|
|
$cnt++;
|
|
}
|
|
|
|
$act = printMenu($mhead, $mopts, $mfoot, $mask);
|
|
print($clear_string);
|
|
if ($act eq 0) {
|
|
return;
|
|
} elsif ($act eq 1) {
|
|
$out = addServer($num);
|
|
} elsif ($act eq 2) {
|
|
return delNetwork($num);
|
|
} elsif ($act =~ /^\d+$/) {
|
|
my $c = $cnt-3;
|
|
if (($cnt-$act) le 0) {
|
|
$out = "This network has only $c servers";
|
|
} else {
|
|
$out = deleteServer($num, $act-3)
|
|
}
|
|
} else {
|
|
$out = "Invalid server ID";
|
|
}
|
|
printEditNetwork($num, $out);
|
|
}
|
|
|
|
sub main_menu {
|
|
my ($txt) = @_;
|
|
my ($act, $out, $warn, $mopts, $mhead, $mfoot);
|
|
my ($mhead, $mask);
|
|
|
|
$mopts = {
|
|
1 => 'Set global options',
|
|
2 => 'Add a new network',
|
|
3 => 'Add a new user',
|
|
3.5 => undef,
|
|
4 => 'View global options',
|
|
5 => 'View/Edit/Delete networks',
|
|
6 => 'View/Edit/Delete users',
|
|
7 => 'Generate a server certificate/key pair',
|
|
8 => 'Switch to ' . invMode($mode) . ' mode',
|
|
8.5 => undef,
|
|
10 => 'Exit: store, write configuration and exit',
|
|
11 => 'Exit without saving',
|
|
12 => 'Store configuration for later use',
|
|
12.5 => undef,
|
|
20 => 'Reset config options',
|
|
21 => 'Load stored config',
|
|
22 => 'Parse and load current config (todo)',
|
|
};
|
|
$mhead = [
|
|
"Welcome to bip configuration program.",
|
|
"This script will help you build a configuration file",
|
|
];
|
|
$mfoot = [ $txt ];
|
|
$mask = "What do you want to do ?";
|
|
|
|
$act = printMenu($mhead, $mopts, $mfoot, $mask);
|
|
print($clear_string);
|
|
if ($act eq 0) {
|
|
} elsif ($act eq 1) {
|
|
$out = setOptions();
|
|
} elsif ($act eq 2) {
|
|
$out = addEntry('network');
|
|
if ($out) {
|
|
push(@{$cf{'networks'}}, $out);
|
|
$out = "New network added";
|
|
} else {
|
|
$out = "Network add failed";
|
|
}
|
|
} elsif ($act eq 3) {
|
|
$out = addEntry('user');
|
|
if ($out) {
|
|
push(@{$cf{'users'}}, $out);
|
|
$out = "New user added";
|
|
} else {
|
|
$out = "User add failed";
|
|
}
|
|
} elsif ($act eq 4) {
|
|
$out = printOptions();
|
|
} elsif ($act eq 5) {
|
|
$out = printNetworks();
|
|
} elsif ($act eq 6) {
|
|
$out = printUsers();
|
|
} elsif ($act eq 7) {
|
|
$out = makeCert();
|
|
} elsif ($act eq 8) {
|
|
$mode = invMode();
|
|
$out = "Ok, configuration mode set to $mode";
|
|
} elsif ($act eq 10) {
|
|
print Dumper(\%cf) if ($DEBUG);
|
|
$out = storeConfig($sfile);
|
|
print ("$out\n") if ($out);
|
|
writeConfig($CFILE);
|
|
exit(0);
|
|
} elsif ($act eq 11) {
|
|
print Dumper(\%cf) if ($DEBUG);
|
|
exit(0);
|
|
} elsif ($act eq 12) {
|
|
$out = storeConfig($sfile);
|
|
print ("$out\n") if ($out);
|
|
pause();
|
|
} elsif ($act eq 20) {
|
|
$out = resetConfig();
|
|
} elsif ($act eq 21) {
|
|
$out = loadConfig($sfile);
|
|
}
|
|
main_menu($out);
|
|
}
|
|
|
|
sub invMode {
|
|
return ($mode eq 'advanced' ? 'normal' : 'advanced');
|
|
}
|
|
|
|
if (! -e $bipdir) {
|
|
mkdir($bipdir) || fatal("Unable to create bip's dir `$bipdir'");
|
|
} elsif (! -d $bipdir) {
|
|
fatal("Bip's dir `$bipdir' already exists and is not a directory");
|
|
} elsif (! -w $bipdir) {
|
|
fatal("Bip's dir `$bipdir' already exists and is not writable");
|
|
}
|
|
|
|
main_menu();
|
|
#sets config backlog
|
|
#different user/nick/real ?
|
|
|
|
|
|
####################
|
|
# Serialize code, from Scott Hurring's serialize serialize module
|
|
# see http://hurring.com/ for more
|
|
# TODO maybe use Storable ?
|
|
|
|
sub serialize {
|
|
my ($value) = @_;
|
|
return serialize_value($value);
|
|
}
|
|
|
|
sub serialize_key {
|
|
my ($value) = @_;
|
|
my $s;
|
|
|
|
# Serialize this as an integer
|
|
if ($value =~ /^\d+$/) {
|
|
# Kevin Haidl - PHP can only handle (((2**32)/2) - 1)
|
|
# before value must be serialized as a double
|
|
if (abs($value) > ((2**32)/2-1)) {
|
|
$s = "d:$value;";
|
|
}
|
|
else {
|
|
$s = "i:$value;";
|
|
}
|
|
}
|
|
|
|
# Serialize everything else as a string
|
|
else {
|
|
my $vlen = length($value);
|
|
$s = "s:$vlen:\"$value\";";
|
|
}
|
|
|
|
return $s;
|
|
}
|
|
|
|
sub serialize_value {
|
|
my ($value) = @_;
|
|
my $s;
|
|
|
|
$value = defined($value) ? $value : '';
|
|
|
|
# This is a hash ref
|
|
if ( ref($value) =~ /hash/i) {
|
|
#The data in the hashref
|
|
my $num = keys(%{$value});
|
|
$s .= "a:$num:{";
|
|
foreach my $k ( keys(%$value) ) {
|
|
$s .= serialize_key( $k );
|
|
$s .= serialize_value( $$value{$k} );
|
|
}
|
|
$s .= "}";
|
|
}
|
|
|
|
# This is an array ref
|
|
elsif ( ref($value) =~ /array/i) {
|
|
#The data in the arrayref
|
|
my $num = @{$value};
|
|
$s .= "a:$num:{";
|
|
for (my $k=0; $k < @$value; $k++ ) {
|
|
$s .= serialize_key( $k );
|
|
$s .= serialize_value( $$value[$k] );
|
|
}
|
|
$s .= "}";
|
|
}
|
|
|
|
# This is a double
|
|
# Thanks to Konrad Stepien <konrad@interdata.net.pl>
|
|
# for pointing out correct handling of negative numbers.
|
|
elsif ($value =~ /^\-?(\d+)\.(\d+)$/) {
|
|
$s = "d:$value;";
|
|
}
|
|
|
|
# This is an integer
|
|
elsif ($value =~ /^\-?\d+$/) {
|
|
# Kevin Haidl - PHP can only handle (((2**32)/2) - 1)
|
|
# before value must be serialized as a double
|
|
if (abs($value) > ((2**32)/2-1)) {
|
|
$s = "d:$value;";
|
|
}
|
|
else {
|
|
$s = "i:$value;";
|
|
}
|
|
}
|
|
|
|
# This is a NULL value
|
|
#
|
|
# Only values of "\0" will be serialized as NULL
|
|
# Empty strings are not NULL, they are simply empty strings.
|
|
# @note Differs from v0.7 where string "NULL" was serialized as "N;"
|
|
elsif ($value eq "\0") {
|
|
$s = "N;";
|
|
}
|
|
|
|
# Anything else is interpreted as a string
|
|
else {
|
|
my $vlen = length($value);
|
|
$s = "s:$vlen:\"$value\";";
|
|
}
|
|
|
|
return $s;
|
|
}
|
|
|
|
sub unserialize {
|
|
my ($string) = @_;
|
|
return unserialize_value($string);
|
|
}
|
|
|
|
sub unserialize_value {
|
|
my ($value) = @_;
|
|
|
|
# Thanks to Ron Grabowski [ronnie (at) catlover.com] for suggesting
|
|
# the need for single-value unserialize code
|
|
|
|
# This is an array
|
|
if ($value =~ /^a:(\d+):\{(.*)\}$/) {
|
|
serialize_dbg("Unserializing array");
|
|
|
|
my @chars = split(//, $2);
|
|
|
|
# Add one extra char at the end so that the loop has one extra
|
|
# cycle to hit the 'set' state and set the final value
|
|
# Otherwise it'll terminate before setting the last value
|
|
push(@chars, ';');
|
|
|
|
return unserialize_sub({}, $1*2, \@chars);
|
|
}
|
|
|
|
# This is a single string
|
|
elsif ($value =~ /^s:(\d+):(.*);$/) {
|
|
serialize_dbg("Unserializing single string ($value)");
|
|
#$string =~ /^s:(\d+):/;
|
|
return $2;
|
|
#return substr($string, length($1) + 4, $1);
|
|
}
|
|
|
|
# This is a single integer or double value
|
|
elsif ($value =~ /^(i|d):(\-?\d+\.?\d+?);$/) {
|
|
serialize_dbg("Unserializing integer or double ($value)");
|
|
return $2
|
|
#substr($string, 2) + 0;
|
|
}
|
|
|
|
# This is a NULL value
|
|
# Thanks to Julian Jares [jjares at uolsinectis.com.ar]
|
|
elsif ($value == /^N;$/i) {
|
|
serialize_dbg("Unserializing NULL value ($value)");
|
|
return "\0";
|
|
}
|
|
|
|
# This is a boolean
|
|
# Thanks to Charles M Hall (cmhall at hawaii dot edu)
|
|
elsif ($value =~/^b:(\d+);$/) {
|
|
serialize_dbg("Unserializing boolean value ($value)");
|
|
return $1;
|
|
}
|
|
|
|
# Invalid data
|
|
else {
|
|
serialize_dbg("Unserializing BAD DATA!\n($value)");
|
|
die("Trying to unserialize bad data!");
|
|
return '';
|
|
}
|
|
|
|
}
|
|
|
|
sub unserialize_sub {
|
|
my ($hashref, $keys, $chars) = @_;
|
|
my ($temp, $keyname, $skip, $strlen);
|
|
my $mode = 'normal'; #default mode
|
|
|
|
serialize_dbg("> unserialize: $hashref, $keys, $chars");
|
|
|
|
# Loop through the data char-by-char, eating them as we go...
|
|
while ( defined(my $c = shift @{$chars}) )
|
|
{
|
|
serialize_dbg("\twhile [$mode] = $c (skip=$skip)");
|
|
|
|
# Processing a serialized string
|
|
# Format: s:length:"data"
|
|
if ($mode eq 'string') {
|
|
$skip = 1; #how many chars should 'readstring' skip?
|
|
#skip initial quote " at the beginning.
|
|
|
|
#find out how many chars need to be read
|
|
if ($c =~ /\d+/) {
|
|
#get the length of string
|
|
$strlen = $strlen . $c;
|
|
}
|
|
|
|
#if we already have a length, and see ':', we know that
|
|
#the actual string is coming next (see format above)
|
|
|
|
if (($strlen =~ /\d+/) && ($c eq ':')) {
|
|
serialize_dbg("[string] length = $strlen");
|
|
$mode = 'readstring';
|
|
}
|
|
|
|
}
|
|
# Read $strlen number of characters into $temp
|
|
elsif ($mode eq 'readstring') {
|
|
next if ($skip && ($skip-- > 0));
|
|
$mode = 'set', next if (!$strlen--);
|
|
|
|
$temp .= $c;
|
|
|
|
}
|
|
|
|
# Process a serialized integer
|
|
# Format: i:data
|
|
elsif ($mode eq 'integer') {
|
|
next if ($c eq ':');
|
|
$mode = 'set', next if ($c eq ';');
|
|
|
|
# Grab the digits
|
|
# Thanks to Konrad Stepien <konrad@interdata.net.pl>
|
|
# for pointing out correct handling of negative numbers.
|
|
if ($c =~ /\-|\d+/) {
|
|
if ($c eq '-') {
|
|
$temp .= $c unless $temp;
|
|
} else {
|
|
$temp .= $c;
|
|
}
|
|
}
|
|
}
|
|
|
|
# Process a serialized double
|
|
# Format: d:data
|
|
elsif ($mode eq 'double') {
|
|
next if ($c eq ':');
|
|
$mode = 'set', next if ($c eq ';');
|
|
|
|
# Grab the digits
|
|
# Thanks to Konrad Stepien <konrad@interdata.net.pl>
|
|
# for pointing out correct handling of negative numbers.
|
|
if ($c =~ /\-|\d+|\./) {
|
|
if ($c eq '-') {
|
|
$temp .= $c unless $temp;
|
|
} else {
|
|
$temp .= $c;
|
|
}
|
|
}
|
|
}
|
|
|
|
# Process a serialized NULL value
|
|
# Format: N
|
|
# Thanks to Julian Jares [jjares at uolsinectis.com.ar]
|
|
elsif ($mode eq 'null') {
|
|
|
|
# Set $temp to something perl will recognize as null "\0"
|
|
# Don't unserialize as an empty string, becuase PHP
|
|
# serializes empty srings as empty strings, not null.
|
|
$temp = "\0";
|
|
|
|
$mode = 'set', next;
|
|
}
|
|
|
|
# Process an array
|
|
# Format: a:num_of_keys:{...}
|
|
elsif ($mode eq 'array') {
|
|
|
|
# Start of array definition, start processing it
|
|
if ($c eq '{') {
|
|
|
|
$temp = unserialize_sub( $$hashref{$keyname}, ($temp*2), $chars );
|
|
|
|
# If temp is an empty array, change to {}
|
|
# Thanks to Charles M Hall (cmhall at hawaii dot edu)
|
|
if(!defined($temp) || $temp eq "") {
|
|
$temp = {};
|
|
}
|
|
|
|
$mode = 'set', next;
|
|
}
|
|
|
|
# Reading in the number of keys in this array
|
|
elsif ($c =~ /\d+/) {
|
|
$temp = $temp . $c;
|
|
serialize_dbg("array_length = $temp ($c)");
|
|
}
|
|
}
|
|
|
|
# Do something with the $temp variable we read in.
|
|
# It's either holding data for a key or a value.
|
|
elsif ($mode eq 'set') {
|
|
|
|
# The keyname has already been set, so that means
|
|
# $temp holds the value
|
|
if (defined($keyname)) {
|
|
serialize_dbg("set [$keyname]=$temp");
|
|
|
|
$$hashref{$keyname} = $temp;
|
|
|
|
# blank out keyname
|
|
undef $keyname;
|
|
}
|
|
|
|
# $temp holds a keyname
|
|
else {
|
|
serialize_dbg("set KEY=$temp");
|
|
$keyname = $temp;
|
|
}
|
|
|
|
undef $temp;
|
|
$mode = 'normal'; # dont eat any chars
|
|
}
|
|
|
|
# Figure out what the upcoming value is and set the state for it.
|
|
if ($mode eq 'normal') {
|
|
# Blank out temp vars used by previous state.
|
|
$strlen = $temp = '';
|
|
|
|
if (!$keys) {
|
|
serialize_dbg("return normally, finished processing keys");
|
|
return $hashref;
|
|
}
|
|
|
|
# Upcoming information is integer
|
|
if ($c eq 'i') {
|
|
$mode = 'integer';
|
|
$keys--;
|
|
}
|
|
# Upcoming information is a bool,
|
|
# process the same as an integer
|
|
if ($c eq 'b') {
|
|
$mode = 'integer';
|
|
$keys--;
|
|
}
|
|
# Upcoming information is a double
|
|
if ($c eq 'd') {
|
|
$mode = 'double';
|
|
$keys--;
|
|
}
|
|
# Upcoming information is string
|
|
if ($c eq 's') {
|
|
$mode = 'string';
|
|
$keys--;
|
|
}
|
|
# Upcoming information is array/hash
|
|
if ($c eq 'a') {
|
|
$mode = 'array';
|
|
$keys--;
|
|
}
|
|
# Upcoming information is a null value
|
|
if ($c eq 'N') {
|
|
$mode = 'null';
|
|
$keys--;
|
|
}
|
|
}
|
|
|
|
} #while there are chars to process
|
|
|
|
|
|
# You should never hit this point.
|
|
# If you do hit this, it means that the code was expecting more
|
|
# characters than it was given.
|
|
# Perhaps your data was unexpectedly truncated or mutilated?
|
|
|
|
serialize_dbg("> unserialize_sub ran out of chars when it was expecting more.");
|
|
die("unserialize_sub() ran out of characters when it was expecting more.");
|
|
|
|
return 0;
|
|
}
|
|
|
|
sub serialize_dbg {
|
|
my ($string) = @_;
|
|
if ($SERIALIZE_DBG) {
|
|
print $string ."\n";
|
|
}
|
|
}
|