perl/Thingy/Rt.pm

   1 #
   2 # Route Thingy handling
   3 #
   4 # $Id$
   5 #
   6 # Copyright (c) 2005 Dirk Koopman G1TLH
   7 #
   8
   9 use strict;
  10
  11 package Thingy::Rt;
  12
  13 use vars qw($VERSION $BRANCH);
  14
  15 main::mkver($VERSION = q$Revision$);
  16
  17 use DXChannel;
  18 use DXDebug;
  19 use DXUtil;
  20 use Thingy;
  21 use Spot;
  22
  23 use vars qw(@ISA);
  24 @ISA = qw(Thingy);
  25
  26 sub gen_Aranea
  27 {
  28         my $thing = shift;
  29         unless ($thing->{Aranea}) {
  30                 my @items;
  31                 $thing->{Aranea} = Aranea::genmsg($thing, 'RT', @items);
  32         }
  33         return $thing->{Aranea};
  34 }
  35
  36 sub from_Aranea
  37 {
  38         my $thing = shift;
  39         return unless $thing;
  40         return $thing;
  41 }
  42
  43 sub gen_DXProt
  44 {
  45         my $thing = shift;
  46         my $dxchan = shift;
  47         return $thing->{DXProt};
  48 }
  49
  50 #sub gen_DXCommandmode
  51 #{
  52 #       my $thing = shift;
  53 #       my $dxchan = shift;
  54 #       my $buf;
  55 #
  56 #       return $buf;
  57 #}
  58
  59 sub from_DXProt
  60 {
  61         my $thing = shift;
  62         while (@_) {
  63                 my $k = shift;
  64                 $thing->{$k} = shift;
  65         }
  66         ($thing->{hops}) = $thing->{DXProt} =~ /\^H(\d+)\^?~?$/ if exists $thing->{DXProt};
  67         return $thing;
  68 }
  69
  70 sub handle
  71 {
  72         my $thing = shift;
  73         my $dxchan = shift;
  74
  75         if ($thing->{t}) {
  76                 my $sub = "handle_$thing->{t}";
  77                 if ($thing->can($sub)) {
  78                         no strict 'refs';
  79                         $thing = $thing->$sub($dxchan);
  80                 }
  81
  82                 $thing->broadcast($dxchan) if $thing;
  83         }
  84 }
  85
  86 sub handle_eau
  87 {
  88         my $thing = shift;
  89         my $dxchan = shift;
  90
  91         if (my $d = $thing->{d}) {
  92                 my $nref;
  93                 for (split /:/, $d) {
  94                         my ($type, $here, $call) = unpack "A1 A1 A*", $_;
  95                         if ($type eq 'U') {
  96                                 unless ($nref) {
  97                                         dbg("Thingy::Rt::ea need a node before $call");
  98                                         return;
  99                                 }
 100                                 add_user($nref, $call, $here);
 101                                 my $h = $dxchan->{call} eq $nref->{call} ? 3 : ($thing->{hops} || 99);
 102                                 RouteDB::update($call, $dxchan->{call}, $h);
 103                         } elsif ($type eq 'N') {
 104                                 $nref = Route::Node::get($call);
 105                                 unless ($nref) {
 106                                         dbg("Thingy::Rt::ea need a definition for $call");
 107                                         return;
 108                                 }
 109                                 my $h = $dxchan->{call} eq $nref->{call} ? 2 : ($thing->{hops} || 99);
 110                                 RouteDB::update($nref->{call}, $dxchan->{call}, $h);
 111                         } else {
 112                                 dbg("Thingy::Rt::ea invalid type $type");
 113                                 return;
 114                         }
 115                 }
 116         }
 117         return $thing;
 118 }
 119
 120 sub handle_edu
 121 {
 122         my $thing = shift;
 123         my $dxchan = shift;
 124
 125         if (my $d = $thing->{d}) {
 126                 my $nref;
 127                 for (split /:/, $d) {
 128                         my ($type, $here, $call) = unpack "A1 A1 A*", $_;
 129                         if ($type eq 'U') {
 130                                 unless ($nref) {
 131                                         dbg("Thingy::Rt::ed need a node before $call");
 132                                         return;
 133                                 }
 134                                 $nref->del_user($call);
 135                                 RouteDB::delete($call, $dxchan->{call});
 136                         } elsif ($type eq 'N') {
 137                                 $nref = Route::Node::get($call);
 138                                 unless ($nref) {
 139                                         dbg("Thingy::Rt::ed need a definition for $call");
 140                                         return;
 141                                 }
 142                                 RouteDB::update($nref->{call}, $dxchan->{call}, $dxchan->{call} eq $nref->{call} ? 2 : ($thing->{hops} || 99));
 143                         } else {
 144                                 dbg("Thingy::Rt::ed invalid type $type");
 145                                 return;
 146                         }
 147                 }
 148         }
 149         return $thing;
 150 }
 151
 152 sub in_filter
 153 {
 154         my $thing = shift;
 155         my $dxchan = shift;
 156
 157         # global route filtering on INPUT
 158         if ($dxchan->{inroutefilter}) {
 159                 my $r = Route::Node::get($thing->{origin});
 160                 my ($filter, $hops) = $dxchan->{inroutefilter}->it($dxchan->{call}, $dxchan->{dxcc}, $dxchan->{itu}, $dxchan->{cq}, $r->{call}, $r->{dxcc}, $r->{itu}, $r->{cq}, $dxchan->{state}, $r->{state});
 161                 unless ($filter) {
 162                         dbg("PCPROT: Rejected by input route filter") if isdbg('chanerr');
 163                         return;
 164                 }
 165         }
 166         return 1;
 167 }
 168
 169 sub out_filter
 170 {
 171         my $thing = shift;
 172         my $dxchan = shift;
 173
 174         # global route filtering on OUTPUT
 175         if ($dxchan->{routefilter}) {
 176                 my $r = Route::Node::get($thing->{origin});
 177                 my ($filter, $hops) = $dxchan->{routefilter}->it($dxchan->{call}, $dxchan->{dxcc}, $dxchan->{itu}, $dxchan->{cq}, $r->{call}, $r->{dxcc}, $r->{itu}, $r->{cq}, $dxchan->{state}, $r->{state});
 178                 unless ($filter) {
 179                         dbg("PCPROT: Rejected by output route filter") if isdbg('chanerr');
 180                         return;
 181                 }
 182                 $thing->{hops} = $hops if $hops;
 183         } elsif ($dxchan->{isolate}) {
 184                 return;
 185         }
 186         return 1;
 187 }
 188
 189 sub add_user
 190 {
 191         my $node = shift;
 192         my $user = shift;
 193         my $flag = shift;
 194
 195         $node->add_user($user, $flag);
 196         my $ur = upd_user_rec($user, $node);
 197         $ur->put;
 198 }
 199
 200 sub upd_user_rec
 201 {
 202         my $call = shift;
 203         my $parentcall = shift;
 204
 205         # add this station to the user database, if required
 206         $call =~ s/-\d+$//o;    # remove ssid for users
 207         my $user = DXUser->get_current($call);
 208         $user = DXUser->new($call) if !$user;
 209         $user->homenode($parentcall) if !$user->homenode;
 210         $user->node($parentcall);
 211         $user->lastin($main::systime) unless DXChannel->get($call);
 212         return $user;
 213 }
 214 1;