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                 push @items, 't', $thing->{t} if $thing->{t};
  32                 push @items, 'd', $thing->{d} if $thing->{d};
  33                 $thing->{Aranea} = Aranea::genmsg($thing, 'RT');
  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                 my $nref;
  95                 for (split /:/, $d) {
  96                         my ($type, $here, $call) = unpack "A1 A1 A*", $_;
  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                 }
 118         }
 119         return $thing;
 120 }
 121
 122 sub handle_edu
 123 {
 124         my $thing = shift;
 125         my $dxchan = shift;
 126
 127         if (my $d = $thing->{d}) {
 128                 my $nref;
 129                 for (split /:/, $d) {
 130                         my ($type, $here, $call) = unpack "A1 A1 A*", $_;
 131                         if ($type eq 'U') {
 132                                 unless ($nref) {
 133                                         dbg("Thingy::Rt::edu need a node before $call");
 134                                         return;
 135                                 }
 136                                 my $uref = Route::User::get($call);
 137                                 unless ($uref) {
 138                                         dbg("Thingy::Rt::edu $call not a user") if isdbg('chanerr');
 139                                         next;
 140                                 }
 141                                 $nref->del_user($uref);
 142                                 RouteDB::delete($call, $dxchan->{call});
 143                         } elsif ($type eq 'N') {
 144                                 $nref = Route::Node::get($call);
 145                                 unless ($nref) {
 146                                         dbg("Thingy::Rt::ed need a definition for $call");
 147                                         return;
 148                                 }
 149                                 RouteDB::update($nref->{call}, $dxchan->{call}, $dxchan->{call} eq $nref->{call} ? 2 : ($thing->{hops} || 99));
 150                         } else {
 151                                 dbg("Thingy::Rt::ed invalid type $type");
 152                                 return;
 153                         }
 154                 }
 155         }
 156         return $thing;
 157 }
 158
 159 sub in_filter
 160 {
 161         my $thing = shift;
 162         my $dxchan = shift;
 163
 164         # global route filtering on INPUT
 165         if ($dxchan->{inroutefilter}) {
 166                 my $r = Route::Node::get($thing->{origin});
 167                 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});
 168                 unless ($filter) {
 169                         dbg("PCPROT: Rejected by input route filter") if isdbg('chanerr');
 170                         return;
 171                 }
 172         }
 173         return 1;
 174 }
 175
 176 sub out_filter
 177 {
 178         my $thing = shift;
 179         my $dxchan = shift;
 180
 181         # global route filtering on OUTPUT
 182         if ($dxchan->{routefilter}) {
 183                 my $r = Route::Node::get($thing->{origin});
 184                 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});
 185                 unless ($filter) {
 186                         dbg("PCPROT: Rejected by output route filter") if isdbg('chanerr');
 187                         return;
 188                 }
 189                 $thing->{hops} = $hops if $hops;
 190         } elsif ($dxchan->{isolate}) {
 191                 return;
 192         }
 193         return 1;
 194 }
 195
 196 sub add_user
 197 {
 198         my $node = shift;
 199         my $user = shift;
 200         my $flag = shift;
 201
 202         $node->add_user($user, $flag);
 203         my $ur = upd_user_rec($user, $node);
 204         $ur->put;
 205 }
 206
 207 sub upd_user_rec
 208 {
 209         my $call = shift;
 210         my $parentcall = shift;
 211
 212         # add this station to the user database, if required
 213         $call =~ s/-\d+$//o;    # remove ssid for users
 214         my $user = DXUser->get_current($call);
 215         $user = DXUser->new($call) if !$user;
 216         $user->homenode($parentcall) if !$user->homenode;
 217         $user->node($parentcall);
 218         $user->lastin($main::systime) unless DXChannel->get($call);
 219         return $user;
 220 }
 221 1;