#!/usr/bin/env perl use strict; #use serialize; use IO::File; use Data::Dumper; my $CFILE = $ENV{'HOME'} . '/.bip/bip.conf.autogen'; my $CONFIG = ".config"; 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 $certout = $ENV{'HOME'} . '/.bip/bip.pem.autogen'; 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' => $ENV{'HOME'} . '/.bip/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 the logging system ?' }, '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' => $ENV{'HOME'} . '/.bip/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}:' }, '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 ?' }, 'bl_msg_only' => { 'type' => 'b', 'adv' => 0, 'optional' => 1, 'default' => 'false', 'depends' => 'backlog', 'depval' => 'true', 'desc' => 'Only playback users messages {chan/priv}, no nick/join/... ?' }, 'always_backlog' => { 'type' => 'b', 'adv' => 0, 'optional' => 1, 'default' => 'false', 'depends' => 'backlog', 'depval' => 'true', 'desc' => 'Always backlog {false means backlog pointers are reset after each backlog} ?' }, 'blreset_on_talk' => { 'type' => 'b', 'adv' => 0, 'optional' => 1, 'default' => 'false', 'depends' => 'backlog', 'depval' => 'true', 'desc' => 'Reset backlog when an attached client sends is talking ?' }, }, '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 ?' }, 'password' => { 'type' => 'p', 'adv' => 0, 'default' => '', 'optional' => 0, 'desc' => 'Set a password for his bip account:' }, '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' }, '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' }, '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_sync_interval' , 'log_level' , 'log_root' , 'log_format' , undef, 'backlog' , 'backlog_lines' , 'backlog_no_timestamp' , 'bl_msg_only' , 'always_backlog' , 'blreset_on_talk' , ], 'network' => [ 'name' , 'ssl' , 'server' , ], 'user' => [ 'name' , 'password' , 'ssl_check_mode' , 'ssl_check_store' , undef, 'default_nick' , 'default_user' , 'default_realname' , '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' , '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) = @_; 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); } else { $o = askval($e->{'desc'}, $sel, ($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 = ) { 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 '' && ! -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 = ) { 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 { -e "$CONFIG" || return "There's no saved configuration at the moment"; my $data; my $fh = new IO::File; $fh->open($CONFIG) || return "Unable to open $CONFIG"; while ($data .= <$fh>) {}; %cf = unserialize($data) || return "Invalid format in $CONFIG"; return "Config loaded from $CONFIG"; } 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 "$CONFIG" || return "Configuration cleared"; my $r = askbool("Do you want to delete saved configuration file $CONFIG too ?", 'false'); if ($r eq 'true') { unlink($CONFIG) || return "Unable to remove file $CONFIG, 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'}}) { my $e = $optdesc{'global'}->{$n}; 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 :"); $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; $fh->open('> ' . $f) || return "Unable to open $f for writing"; 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 "true"); my $t = $optdesc{'global'}->{$k}->{'type'}; if ($t eq 's' || $t eq 'b') { 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"); return; } 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 (keys(%{$e})) { next if ($e->{$k} eq undef); next if ($optdesc{$name}->{$k}->{'nosave'} eq "true"); my $t = $optdesc{$name}->{$k}->{'type'}; if ($t eq 's' || $t eq 'b') { $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); } elsif ($v->{'type'} eq 'p') { $e->{$n} = askPass($v->{'desc'}); } 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"); ; } 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 = scalar @{$n}; if ($c lt $act) { $out = "There is 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 = scalar @{$n}; if ($c lt $act) { $out = "There is 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 { #TODO } 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 = (scalar @{$sub}); if ($c le $act-4) { $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 { # TODO } 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 = (scalar @{$sub}); if ($c le $act-4) { $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", undef, undef, $warn, ]; $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 = (scalar @{$sub}); if ($c le $act-3) { $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', 4 => 'View/Edit/Unset global options', 5 => 'View/Edit/Delete networks', 6 => 'View/Edit/Delete users (todo)', 7 => 'Generate a server certificate/key pair', 8 => 'Load saved config (todo)', 9 => 'Parse and load current config (todo)', 10 => 'Reset config options', 11 => 'Switch to ' . invMode($mode) . ' mode', 12 => undef, 90 => 'Save and exit', 91 => 'Debug (will be exit)', }; $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 8) { $out = loadConfig(); } elsif ($act eq 10) { $out = resetConfig(); } elsif ($act eq 4) { $out = printOptions(); } elsif ($act eq 1) { $out = setOptions(); } elsif ($act eq 6) { $out = printUsers(); } 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 5) { $out = printNetworks(); } 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 7) { $out = makeCert(); } elsif ($act eq 11) { $mode = invMode(); $out = "Ok, configuration mode set to $mode"; } elsif ($act eq 90) { $out = writeConfig($CFILE); if (!$out) { 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"; exit(0); } } elsif ($act eq 91) { print Dumper(\%cf); pause(); # exit(0); } main_menu($out); } sub invMode { return ($mode eq 'advanced' ? 'normal' : 'advanced'); } main_menu(); #sets config backlog #different user/nick/real ?