X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXCommandmode.pm;h=b3718721c69a843fe947c8a06d0725f0f36c37dc;hb=f43ac25669a7b9368d9537eed2043a864a906303;hp=6306b7fbed905902abea96f23d9a14c219e98e31;hpb=63f0fc26e717837bc7c6990f27d26de91d65eb7e;p=spider.git diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index 6306b7fb..b3718721 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -13,7 +13,7 @@ package DXCommandmode; @ISA = qw(DXChannel); -require 5.10.1; +use 5.10.1; use POSIX qw(:math_h); use DXUtil; @@ -43,12 +43,15 @@ use JSON; use Time::HiRes qw(gettimeofday tv_interval); use Mojo::IOLoop; -use Mojo::IOLoop::Subprocess; +use DXSubprocess; use Mojo::UserAgent; +use DXCIDR; use strict; use vars qw(%Cache %cmd_cache $errstr %aliases $scriptbase %nothereslug - $maxbadcount $msgpolltime $default_pagelth $cmdimportdir $users $maxusers); + $maxbadcount $msgpolltime $default_pagelth $cmdimportdir $users $maxusers + $maxcmdlth $maxcmdcount $cmdinterval +); %Cache = (); # cache of dynamically loaded routine's mod times %cmd_cache = (); # cache of short names @@ -61,6 +64,9 @@ $cmdimportdir = "$main::root/cmd_import"; # the base directory for importing com # this does not exist as default, you need to create it manually $users = 0; # no of users on this node currently $maxusers = 0; # max no users on this node for this run +$maxcmdlth = 512; # max length of incoming cmd line (including the command and any arguments +$maxcmdcount = 27; # max no cmds entering $cmdinterval seconds +$cmdinterval = 20; # if user enters more than $maxcmdcount in $cmdinterval seconds, they are logged off # # obtain a new connection this is derived from dxchannel @@ -73,14 +79,15 @@ sub new # routing, this must go out here to prevent race condx my $pkg = shift; my $call = shift; -# my @rout = $main::routeroot->add_user($call, Route::here(1)); - DXProt::_add_thingy($main::routeroot, [$call, 0, 0, 1, undef, undef, $self->hostname], ); + # my @rout = $main::routeroot->add_user($call, Route::here(1)); + my $ipaddr = alias_localhost($self->hostname); + DXProt::_add_thingy($main::routeroot, [$call, 0, 0, 1, undef, undef, $ipaddr], ); - # ALWAYS output the user + # ALWAYS output the user (except if the updates not enabled) my $ref = Route::User::get($call); if ($ref) { $main::me->route_pc16($main::mycall, undef, $main::routeroot, $ref); - $main::me->route_pc92a($main::mycall, undef, $main::routeroot, $ref) unless $DXProt::pc92_slug_changes; + $main::me->route_pc92a($main::mycall, undef, $main::routeroot, $ref) unless $DXProt::pc92_slug_changes || ! $DXProt::pc92_ad_enable; } return $self; @@ -105,13 +112,15 @@ sub start $self->{name} = $name ? $name : $call; $self->send($self->msg('l2',$self->{name})); + $self->send("Capabilities: ve7cc rbn"); $self->state('prompt'); # a bit of room for further expansion, passwords etc $self->{priv} = $user->priv || 0; $self->{lang} = $user->lang || $main::lang || 'en'; my $pagelth = $user->pagelth; $pagelth = $default_pagelth unless defined $pagelth; $self->{pagelth} = $pagelth; - ($self->{width}) = $line =~ /width=(\d+)/; $line =~ s/\s*width=\d+\s*//; + ($self->{width}) = $line =~ /\s*width=(\d+)/; $line =~ s/\s*width=\d+//; + $self->{enhanced} = $line =~ /\s+enhanced/; $line =~ s/\s*enhanced//; if ($line =~ /host=/) { my ($h) = $line =~ /host=(\d+\.\d+\.\d+\.\d+)/; $line =~ s/\s*host=\d+\.\d+\.\d+\.\d+// if $h; @@ -124,7 +133,7 @@ sub start $self->{width} = 80 unless $self->{width} && $self->{width} > 80; $self->{consort} = $line; # save the connection type - LogDbg('DXCommand', "$call connected from $self->{hostname}"); + LogDbg('DXCommand', "$call connected from $self->{hostname} cols $self->{width}" . ($self->{enhanced}?" enhanced":'')); # set some necessary flags on the user if they are connecting $self->{beep} = $user->wantbeep; @@ -136,29 +145,35 @@ sub start $self->{dx} = $user->wantdx; $self->{logininfo} = $user->wantlogininfo; $self->{ann_talk} = $user->wantann_talk; + $self->{wantrbn} = $user->wantrbn; $self->{here} = 1; $self->{prompt} = $user->prompt if $user->prompt; $self->{lastmsgpoll} = 0; - + $self->{rbnseeme} = $user->rbnseeme; + RBN::add_seeme($call) if $self->{rbnseeme}; + # sort out new dx spot stuff $user->wantdxcq(0) unless defined $user->{wantdxcq}; $user->wantdxitu(0) unless defined $user->{wantdxitu}; $user->wantusstate(0) unless defined $user->{wantusstate}; - + # sort out registration - if ($main::reqreg == 1) { - $self->{registered} = $user->registered; - } elsif ($main::reqreg == 2) { + if ($main::reqreg == 2) { $self->{registered} = !$user->registered; } else { - $self->{registered} = 1; - } + $self->{registered} = $user->registered; + } + + # establish slug queue, if required + $self->{sluggedpcs} = []; + $self->{isslugged} = $DXProt::pc92_slug_changes + $DXProt::last_pc92_slug + 5 if $DXProt::pc92_slug_changes; + $self->{isslugged} = 0 if $self->{priv} || $user->registered || ($user->homenode && $user->homenode eq $main::mycall); # send the relevant MOTD $self->send_motd; # sort out privilege reduction - $self->{priv} = 0 unless $self->{hostname} eq '127.0.0.1' || $self->{hostname} eq '::1' || $self->conn->{usedpasswd}; + $self->{priv} = 0 unless $self->{hostname} eq '127.0.0.1' || $self->conn->peerhost eq '127.0.0.1' || $self->{hostname} eq '::1' || $self->conn->{usedpasswd}; # get the filters my $nossid = $call; @@ -176,7 +191,10 @@ sub start $self->{annfilter} = Filter::read_in('ann', $call, 0) || Filter::read_in('ann', $nossid, 0) || Filter::read_in('ann', 'user_default', 0) ; - + $self->{rbnfilter} = Filter::read_in('rbn', $call, 0) + || Filter::read_in('rbn', $nossid, 0) + || Filter::read_in('rbn', 'user_default', 0); + # clean up qra locators my $qra = $user->qra; $qra = undef if ($qra && !DXBearing::is_qra($qra)); @@ -196,6 +214,11 @@ sub start $self->tell_login('loginu'); $self->tell_buddies('loginb'); + + # is this a bad ip address? + if (is_ipaddr($self->{hostname})) { + $self->{badip} = DXCIDR::find($self->{hostname}); + } # do we need to send a forward/opernam? my $lastoper = $user->lastoper || 0; @@ -210,8 +233,7 @@ sub start $script->run($self) if $script; # send cluster info - my $info = Route::cluster(); - $self->send("Cluster:$info"); + $self->send($self->run_cmd("show/cluster")); # send prompts for qth, name and things $self->send($self->msg('namee1')) if !$user->name; @@ -231,7 +253,12 @@ sub start } $self->lastmsgpoll($main::systime); + $self->{user_interval} = $self->user->user_interval || $main::user_interval; # allow user to change idle time between prompts $self->prompt; + + $self->{cmdintstart} = 0; # set when systime > this + cmdinterval and a command entered, cmdcount set to 0 + $self->{cmdcount} = 0; # incremented on a coming in. If this value > $maxcmdcount, disconnect + } # @@ -243,6 +270,7 @@ sub normal my $self = shift; my $cmdline = shift; my @ans; + my @bad; # save this for them's that need it my $rawline = $cmdline; @@ -251,7 +279,7 @@ sub normal $cmdline =~ s/^\s*(.*)\s*$/$1/; if ($self->{state} eq 'page') { - my $i = $self->{pagelth}; + my $i = $self->{pagelth}-5; my $ref = $self->{pagedata}; my $tot = @$ref; @@ -262,7 +290,7 @@ sub normal } # send a tranche of data - while ($i-- > 0 && @$ref) { + for (; $i > 0 && @$ref; --$i) { my $line = shift @$ref; $line =~ s/\s+$//o; # why am having to do this? $self->send($line); @@ -326,23 +354,25 @@ sub normal } $self->state('prompt'); delete $self->{talklist}; - } elsif ($cmdline =~ m|^/+\w+|) { + } elsif ($cmdline =~ m|^[/\w\\]+|) { $cmdline =~ s|^/||; my $sendit = $cmdline =~ s|^/+||; - my @in = $self->run_cmd($cmdline); - $self->send_ans(@in); - if ($sendit && $self->{talklist} && @{$self->{talklist}}) { - foreach my $l (@in) { - my @bad; - if (@bad = BadWords::check($l)) { - $self->badcount(($self->badcount||0) + @bad); - LogDbg('DXCommand', "$self->{call} swore: $l with words:" . join(',', @bad) . ")"); - } else { - for (@{$self->{talklist}}) { - if ($self->{state} eq 'talk') { - $self->send_talks($_, $l); - } else { - send_chats($self, $_, $l) + if (@bad = BadWords::check($cmdline)) { + $self->badcount(($self->badcount||0) + @bad); + LogDbg('DXCommand', "$self->{call} swore: '$cmdline' with badwords: '" . join(',', @bad) . "'"); + } else { + my @cmd = split /\s*\\n\s*/, $cmdline; + foreach my $l (@cmd) { + my @in = $self->run_cmd($l); + $self->send_ans(@in); + if ($sendit && $self->{talklist} && @{$self->{talklist}}) { + foreach my $l (@in) { + for (@{$self->{talklist}}) { + if ($self->{state} eq 'talk') { + $self->send_talks($_, $l); + } else { + send_chats($self, $_, $l) + } } } } @@ -351,10 +381,9 @@ sub normal $self->send($self->{state} eq 'talk' ? $self->talk_prompt : $self->chat_prompt); } elsif ($self->{talklist} && @{$self->{talklist}}) { # send what has been said to whoever is in this person's talk list - my @bad; if (@bad = BadWords::check($cmdline)) { $self->badcount(($self->badcount||0) + @bad); - LogDbg('DXCommand', "$self->{call} swore: $cmdline with words:" . join(',', @bad) . ")"); + LogDbg('DXCommand', "$self->{call} swore: '$cmdline' with badwords: '" . join(',', @bad) . "'"); } else { for (@{$self->{talklist}}) { if ($self->{state} eq 'talk') { @@ -386,11 +415,33 @@ sub normal } $self->send_ans(@ans); } else { - $self->send_ans(run_cmd($self, $cmdline)); +# if (@bad = BadWords::check($cmdline)) { +# $self->badcount(($self->badcount||0) + @bad); +# LogDbg('DXCommand', "$self->{call} swore: '$cmdline' with badwords: '" . join(',', @bad) . "'"); + # } else { + my @cmd = split /\s*\\n\s*/, $cmdline; + foreach my $l (@cmd) { + + # rate limiting code + + if (($self->{cmdintstart} + $cmdinterval <= $main::systime) || $self->{inscript}) { + $self->{cmdintstart} = $main::systime; + $self->{cmdcount} = 1; + dbg("$self->{call} started cmdinterval") if isdbg('cmdcount'); + } else { + if (++$self->{cmdcount} > $maxcmdcount) { + LogDbg('baduser', qq{User $self->{call} sent $self->{cmdcount} (>= $maxcmdcount) cmds in $cmdinterval seconds starting at } . atime($self->{cmdintstart}) . ", disconnected" ); + $self->disconnect; + } + dbg("$self->{call} cmd: '$l' cmdcount = $self->{cmdcount} in $cmdinterval secs") if isdbg('cmdcount'); + } + $self->send_ans(run_cmd($self, $l)); + } +# } } # check for excessive swearing - if ($self->{badcount} && $self->{badcount} >= $maxbadcount) { + if ($maxbadcount && $self->{badcount} && $self->{badcount} >= $maxbadcount) { LogDbg('DXCommand', "$self->{call} logged out for excessive swearing"); $self->disconnect; return; @@ -432,7 +483,8 @@ sub send_chats my $msgid = DXProt::nextchatmsgid(); $text = "#$msgid $text"; - $main::me->normal(DXProt::pc93($target, $self->{call}, undef, $text)); + my $ipaddr = alias_localhost($self->hostname || '127.0.0.1'); + $main::me->normal(DXProt::pc93($target, $self->{call}, undef, $text, undef, $ipaddr)); } sub special_prompt @@ -511,15 +563,15 @@ sub run_cmd if ($cmd) { - # check cmd - if ($cmd =~ m|^/| || $cmd =~ m|[^-?\w/]|) { - LogDbg('DXCommand', "cmd: invalid characters in '$cmd'"); - return $self->_error_out('e1'); + # strip out // on command only + $cmd =~ s|//+|/|g; + + # check for length of whole command line and any invalid characters + if (length $cmdline > $maxcmdlth || $cmd =~ m|\.| || $cmd !~ m|^\w+(?:/\w+){0,1}(?:/\d+)?$|) { + LogDbg('DXCommand', "cmd: $self->{call} - invalid characters in '$cmd'"); + return $self->_error_out('e40'); } - # strip out // on command only - $cmd =~ s|//|/|g; - my ($path, $fcmd); dbg("cmd: $cmd") if isdbg('command'); @@ -545,26 +597,24 @@ sub run_cmd if ($package && $self->can("${package}::handle")) { no strict 'refs'; dbg("cmd: package $package") if isdbg('command'); - if (isdbg('progress')) { - my $s = "CMD: '$cmd' by $call ip $self->{hostname}"; - } +# Log('cmd', "$self->{call} on $self->{hostname} : '$cmd $args'"); my $t0 = [gettimeofday]; eval { @ans = &{"${package}::handle"}($self, $args) }; if ($@) { - dbgprintring(25); + DXDebug::dbgprintring(25); return (DXDebug::shortmess($@)); } if (isdbg('progress')) { my $msecs = _diffms($t0); my $s = "CMD: '$cmd $args' by $call ip: $self->{hostname} ${msecs}mS"; - dbg($s); + dbg($s) if $cmd !~ /^(?:echo|blank)/ || isdbg('echo'); # cut down a bit on HRD and other clients' noise } } else { dbg("cmd: $package not present") if isdbg('command'); return $self->_error_out('e1'); } } else { - dbg("cmd: $cmd not found") if isdbg('command'); + LogDbg('DXCommand', "$self->{call} cmd: '$cmd' not found"); return $self->_error_out('e1'); } } @@ -573,11 +623,11 @@ sub run_cmd if ($ok) { delete $self->{errors}; } else { - if (++$self->{errors} > $DXChannel::maxerrors) { + if ($self != $main::me && ++$self->{errors} > $DXChannel::maxerrors) { $self->send($self->msg('e26')); $self->disconnect; return (); - } + } } return map {s/([^\s])\s+$/$1/; $_} @ans; } @@ -603,17 +653,23 @@ sub process } # send a prompt if no activity out on this channel - if ($t >= $dxchan->t + $main::user_interval) { + if ($t >= $dxchan->t + $dxchan->{user_interval}) { $dxchan->prompt() if $dxchan->{state} =~ /^prompt/o; $dxchan->t($t); } ++$users; $maxusers = $users if $users > $maxusers; - } - while (my ($k, $v) = each %nothereslug) { - if ($main::systime >= $v + 300) { - delete $nothereslug{$k}; + if ($dxchan->{isslugged} && $main::systime > $dxchan->{isslugged}) { + foreach my $ref (@{$dxchan->{sluggedpcs}}) { + if ($ref->[0] == 61) { + Spot::add(@{$ref->[2]}); + DXProt::send_dx_spot($dxchan, $ref->[1], @{$ref->[2]}); + } + } + + $dxchan->{isslugged} = 0; + $dxchan->{sluggedpcs} = []; } } @@ -631,6 +687,7 @@ sub disconnect return if $self->{disconnecting}++; delete $self->{senddbg}; + RBN::del_seeme($call); my $uref = Route::User::get($call); my @rout; @@ -638,11 +695,11 @@ sub disconnect # @rout = $main::routeroot->del_user($uref); @rout = DXProt::_del_thingy($main::routeroot, [$call, 0]); - dbg("B/C PC17 on $main::mycall for: $call") if isdbg('route'); + # dbg("B/C PC17 on $main::mycall for: $call") if isdbg('route'); # issue a pc17 to everybody interested $main::me->route_pc17($main::mycall, undef, $main::routeroot, $uref); - $main::me->route_pc92d($main::mycall, undef, $main::routeroot, $uref) unless $DXProt::pc92_slug_changes; + $main::me->route_pc92d($main::mycall, undef, $main::routeroot, $uref) unless $DXProt::pc92_slug_changes || ! $DXProt::pc92_ad_enable; } else { confess "trying to disconnect a non existant user $call"; } @@ -839,7 +896,7 @@ sub find_cmd_name { }; #wrap the code into a subroutine inside our unique package - my $eval = qq(package DXCommandmode::$package; use POSIX qw{:math_h}; use DXLog; use DXDebug; use DXUser; use DXUtil; our \@ISA = qw{DXCommandmode}; ); + my $eval = qq(package DXCommandmode::$package; use 5.10.1; use POSIX qw{:math_h}; use DXLog; use DXDebug; use DXUser; use DXUtil; our \@ISA = qw{DXCommandmode}; ); if ($sub =~ m|\s*sub\s+handle\n|) { @@ -850,7 +907,6 @@ sub find_cmd_name { if (isdbg('eval')) { my @list = split /\n/, $eval; - my $line; for (@list) { dbg($_ . "\n") if isdbg('eval'); } @@ -959,7 +1015,7 @@ sub announce $buf = dd(['ann', $to, $target, $text, @_]) } else { $buf = "$to$target de $_[0]: $text"; - $buf =~ s/\%5E/^/g; + #$buf =~ s/\%5E/^/g; $buf .= "\a\a" if $self->{beep}; } $self->local_send($target eq 'WX' ? 'W' : 'N', $buf); @@ -984,7 +1040,7 @@ sub chat $buf = dd(['chat', $to, $target, $text, @_]) } else { $buf = "$target de $_[0]: $text"; - $buf =~ s/\%5E/^/g; + #$buf =~ s/\%5E/^/g; $buf .= "\a\a" if $self->{beep}; } $self->local_send('C', $buf); @@ -995,32 +1051,73 @@ sub format_dx_spot my $self = shift; my $t = ztime($_[2]); - my $loc = ''; - my $clth = $self->{consort} eq 'local' ? 29 : 30; - my $comment = substr (($_[3] || ''), 0, $clth); - $comment .= ' ' x ($clth - length($comment)); - if ($self->{user}->wantgrid) { - my $ref = DXUser::get_current($_[4]); - if ($ref) { - $loc = $ref->qra || ''; - $loc = ' ' . substr($loc, 0, 4) if $loc; + my ($slot1, $slot2) = ('', ''); + + my $clth = 30 + $self->{width} - 80; # allow comment to grow according the screen width + my $c = $_[3]; + $c =~ s/\t/ /g; + my $comment = substr (($c || ''), 0, $clth); + $comment .= ' ' x ($clth - (length($comment))); + + if ($self->{user}) { # to allow the standalone program 'showdx' to work + if (!$slot1 && $self->{user}->wantgrid) { + my $ref = DXUser::get_current($_[1]); + if ($ref && $ref->qra) { + $slot1 = ' ' . substr($ref->qra, 0, 4); + } + } + if (!$slot1 && $self->{user}->wantusstate) { + $slot1 = " $_[12]" if $_[12]; + } + unless ($slot1) { + if ($self->{user}->wantdxitu) { + $slot1 = sprintf(" %2d", $_[8]) if defined $_[8]; + } + elsif ($self->{user}->wantdxcq) { + $slot1 = sprintf(" %2d", $_[9]) if defined $_[9]; + } + } + $comment = substr($comment, 0, $clth-length($slot1)) . $slot1 if $slot1; + + if (!$slot2 && $self->{user}->wantgrid) { + my $origin = $_[4]; + $origin =~ s/-#$//; # sigh...... + my $ref = DXUser::get_current($origin); + if ($ref && $ref->qra) { + $slot2 = ' ' . substr($ref->qra, 0, 4); + } + } + if (!$slot2 && $self->{user}->wantusstate) { + $slot2 = " $_[13]" if $_[13]; + } + unless ($slot2) { + if ($self->{user}->wantdxitu) { + $slot2 = sprintf(" %2d", $_[10]) if defined $_[10]; + } + elsif ($self->{user}->wantdxcq) { + $slot2 = sprintf(" %2d", $_[11]) if defined $_[11]; + } } } - if ($self->{user}->wantdxitu) { - $loc = ' ' . sprintf("%2d", $_[10]) if defined $_[10]; - $comment = substr($comment, 0, $self->{consort} eq 'local' ? 26 : 27) . ' ' . sprintf("%2d", $_[8]) if defined $_[8]; - } elsif ($self->{user}->wantdxcq) { - $loc = ' ' . sprintf("%2d", $_[11]) if defined $_[11]; - $comment = substr($comment, 0, $self->{consort} eq 'local' ? 26 : 27) . ' ' . sprintf("%2d", $_[9]) if defined $_[9]; - } elsif ($self->{user}->wantusstate) { - $loc = ' ' . $_[13] if $_[13]; - $comment = substr($comment, 0, $self->{consort} eq 'local' ? 26 : 27) . ' ' . $_[12] if $_[12]; + my $o = sprintf("%-9s", $_[4] . ':'); + my $qrg = sprintf "%8.1f", $_[0]; + if (length $qrg >= 9) { + while (length($o)+length($qrg) > 17 && $o =~ / $/) { + chop $o; + } + } + my $spot = sprintf "%-12s", $_[1]; + my $front = "DX de $o $qrg $spot"; + while (length($front) > 38 && $front =~ / $/) { + chop $front; } - return sprintf "DX de %-7.7s%11.1f %-12.12s %-s $t$loc", "$_[4]:", $_[0], $_[1], $comment; + + return sprintf "$front %-s $t$slot2", $comment; } + # send a dx spot sub dx_spot { @@ -1062,7 +1159,7 @@ sub dx_spot } else { $buf = $self->format_dx_spot(@_); $buf .= "\a\a" if $self->{beep}; - $buf =~ s/\%5E/^/g; + #$buf =~ s/\%5E/^/g; } $self->local_send('X', $buf); @@ -1265,7 +1362,7 @@ sub send_motd my $self = shift; my $motd; - unless ($self->{registered}) { + unless ($self->isregistered) { $motd = "${main::motd}_nor_$self->{lang}"; $motd = "${main::motd}_nor" unless -e $motd; } @@ -1281,7 +1378,6 @@ sub send_motd $self->send_file($motd) if -e $motd; } - # Punt off a long running command into a separate process # # This is called from commands to run some potentially long running @@ -1311,7 +1407,7 @@ sub spawn_cmd no strict 'refs'; # just behave normally if something has set the "one-shot" _nospawn in the channel - if ($self->{_nospawn}) { + if ($self->{_nospawn} || $main::is_win == 1) { eval { @out = $cmdref->(@$args); }; if ($@) { DXDebug::dbgprintring(25); @@ -1320,18 +1416,23 @@ sub spawn_cmd return @out; } - my $fc = Mojo::IOLoop::Subprocess->new; + my $fc = DXSubprocess->new; # $fc->serializer(\&encode_json); # $fc->deserializer(\&decode_json); $fc->run( sub { my $subpro = shift; if (isdbg('progress')) { - my $s = "line: $line"; - $s .= ", args: " . join(', ', @$args) if $args && @$args; + my $s = qq{$call line: "$line"}; + $s .= ", args: " . join(', ', map { defined $_ ? qq{'$_'} : q{'undef'} } @$args) if $args && @$args; dbg($s); } - eval { @out = $cmdref->(@$args); }; + eval { + ++$self->{_in_sub_process}; + dbg "\$self->{_in_sub_process} = $self->{_in_sub_process}"; + @out = $cmdref->(@$args); + --$self->{_in_sub_process} if $self->{_in_sub_process} > 0; + }; if ($@) { DXDebug::dbgprintring(25); push @out, DXDebug::shortmess($@); @@ -1369,7 +1470,23 @@ sub spawn_cmd sub user_count { - return ($users, $maxusers); + return ($users, $maxusers); } + +# alias localhost if required. This is designed to repress all localhost and other +# internal interfaces to a fixed (outside) IPv4 or IPV6 address +sub alias_localhost +{ + my $hostname = shift; + if ($hostname =~ /./) { + return $hostname unless $main::localhost_alias_ipv4; + return (grep $hostname eq $_, @main::localhost_names) ? $main::localhost_alias_ipv4 : $hostname; + } elsif ($hostname =~ /:/) { + return $hostname unless $main::localhost_alias_ipv6; + return (grep $hostname eq $_, @main::localhost_names) ? $main::localhost_alias_ipv6 : $hostname; + } + return $hostname; +} + 1; __END__