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